请问如何抓取这个网页的数据？

Kaohsing

途牛网

请问如何抓取这个网页的数据？抓包显示有数据，但是抓不到？麻烦大家给看看。

Kaohsing

代码：Dim DicCodeTf
Private Sub 途牛机票()
    Dim strText$, url$
    Dim a$, b$
  
    If IsEmpty(DicCodeTf) Then
       GetCodeDicTF
    End If
    On Error Resume Next
  
     a = hzToUtf8("济南") '出发站
     b = hzToUtf8("兰州") '到达站
    url = "http://www.tuniu.com/flight/city_" & DicCodeTf(a) & "_" & DicCodeTf(b) & "/"
     
     With CreateObject("WinHttp.WinHttpRequest.5.1") 'CreateObject("MSXML2.XMLHTTP") '
      .Open "POST", url, False
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      .setRequestHeader "Referer", "http://www.tuniu.com/flight/"
     ' .setRequestHeader "cookie", ""
      .send "type=1&start=2016-08-19&adult=4&child=1"
       strText = .responsetext
    End With '"
   
  
    strText = HtmlFilter(strText, " var Arg =", "</script>")
   CopyToClipbox strText
   
    Set js = CreateObject("scriptcontrol")
    js.Language = "jscript"
    js.addcode ("ghb =" & strText)
    Stop

End Sub

Sub GetCodeDicTF()
     
   Dim strText$
   Dim regx, mh
    With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", "http://www.tuniu.com/flight/", False
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" '
      .send
       strText = .responsetext
    End With
    strText = HtmlFilter(strText, "var CitiesList =", ";")
   '----------------------------------------------------------------------------------------------------------------
   'Debug.Print strText
   Set regx = CreateObject("vbscript.regexp") '[\u4e00-\u9fff]
   ' regx.Pattern = "(\d{3,4}).{2}\w{8}.{3}((\\[0-9a-z]{5}){2,4})"
   regx.Pattern = "(\d{3,4}).{2}\w{8}.{3}([\u4e00-\u9fff]{2,4})"

    regx.Global = True
    'regx.MultiLine = True
   
    Set DicCodeTf = CreateObject("scripting.dictionary")
    Set mh = regx.Execute(strText)
    Stop
    For Each mhk In mh
      Stop
     If Not DicCodeTf.exists(mhk.SubMatches(0)) Then
       DicCodeTf(mhk.SubMatches(1)) = mhk.SubMatches(0)
       End If
    Next
   
End Sub
Sub CopyToClipbox(strText As String)     '文本拷贝到剪贴板
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText strText
    .PutInClipboard
   End With
End Sub

Public Function HtmlFilter(ByVal htmlText$, Label1$, Label2$)
    '返回html字符串lable1和最近的lable2标签中的数据
    Dim pStart As Long, pStop As Long
    pStart = InStr(htmlText, Label1) + Len(Label1)
                         '找到标签信息的起始位置
    If pStart <> 0 Then
        pStop = InStr(pStart, htmlText, Label2)
        HtmlFilter = Mid(htmlText, pStart, pStop - pStart)
    End If
End Function
Function hzToUtf8(hz As String) As String
    Dim intP As Integer
    Dim strP As String, Tex As String
    For intP = 1 To Len(hz)
        strP = Mid(hz, intP, 1)
        Tex = LCase(Tex & "\u" & Right("0000" & Hex$(AscW(strP)), 4))
    Next intP
    hzToUtf8 = Tex
End Function

liu-aguang

"var Arg=...."行数据并不是航班信息数据. 而是"低价日历"行数据.航班信息数据在另外一个js文件中,其url由javaScrit生成.确定它很麻烦,有兴趣的高手可以去试试.

Kaohsing

谢谢大神，正在看你的正则学习材料，其中有个问题：strText中{........"cityCode":402,"cityName":"\u798f\u5dde","cityAbb .....}想抓取其中的402和\u798f\u5dde，不知正则如何写？恳请指点。

liu-aguang

Kaohsing 发表于 2016-8-12 14:36
谢谢大神，正在看你的正则学习材料，其中有个问题：strText中{........"cityCode":402,"cityName":"%u798f% ...

需要的只是\u798f\u5dde对应的代号,可用正则: (\d+),[^\\]+\\u798f\\u5dde

Kaohsing

可能没说明白，要提取大量的\uxxxx的码，另外 regx.Pattern = "((\d{3,4})(?=.{2}cityName.{3}))(((\\\w{5}){2,4})(?=.{3}cityAbb))"，为什么取不出值？

liu-aguang

Kaohsing 发表于 2016-8-12 16:06
可能没说明白，要提取大量的%uxxxx的码，另外 regx.Pattern = "((\d{3,4})(?=.{2}cityName.{3}))(((\\\w{5} ...

建议不要再折腾了,要提取该网站航班信息太难了.

屌爆了z

liu-aguang 发表于 2016-8-12 17:05
建议不要再折腾了,要提取该网站航班信息太难了.

没多难吧，实在不行可以用IE实现吧

liu-aguang

屌爆了z 发表于 2016-8-12 19:12
没多难吧，实在不行可以用IE实现吧

用IE应该可以的.用msxml2.xmlhttp有点难.

屌爆了z