不懂html也来学网抓（xmlhttp/winhttp+fiddler）

renahu

wcymiss 发表于 2014-10-22 16:45
获取数据-防盗链的处理-动态参数

相同方式操作网页，抓包能得到相同的参数值，这样的参数是静态的。反之 ...

吴老师，请看254和255楼的提问，sn的获取在59楼帖子里是有讲， 但是要看当天信息，还是要用fiddler去抓，不抓sn就无法更新，59楼的两次send和一次send一样啊

浮华、缠绕指尖

吴姐。这几天忙得都没时间做作业了。。。

写了三个简单的。。而且就一个对数据进行了处理，等过段时间闲了再补上。。。

       吴姐别说我懒哈~~~

1. 吴姐。这几天忙得都没时间做作业了。。。
   
2. 写了三个简单的。。而且就一个对数据进行了处理，等过段时间闲了再补上。。。
   
3. [code]Option Explicit
   
4. Dim d As New Dictionary
   
5. Dim xml As New MSXML2.XMLHTTP
   
6. Private Sub optOneway_Change()
   
7.     Me.DTPRetureDate.Enabled = Me.optReture.Value: Me.cmbRetureTime.Enabled = Me.optReture.Value
   
8. End Sub
   
9. Private Sub optReture_Change()
   
10.     Me.DTPRetureDate.Enabled = Me.optReture.Value: Me.cmbRetureTime.Enabled = Me.optReture.Value
    
11. End Sub
    
12. Private Sub UserForm_Initialize()
    
13. Dim i As Integer, strText As String
    
14. Dim arr
    
15.     For i = 7 To 23 Step 2
    
16.         Me.cmbStartTime.AddItem i & "点"
    
17.         Me.cmbRetureTime.AddItem i & "点"
    
18.     Next
    
19.     Me.cmbStartTime.ListIndex = 0
    
20.     Me.cmbRetureTime.ListIndex = 0
    
21.     With xml
    
22.         .Open "GET", "http://www.caac.gov.cn/images/airlinecontrol.js", False
    
23.         .Send
    
24.         arr = Split(执行(BinToStr(.ResponseBody, "GB2312") & "var s='';s=airlines;"), ",")
    
25.             For i = 1 To UBound(arr) Step 2
    
26.                 d(arr(i)) = arr(i - 1)
    
27.                 Me.cmbCompany.AddItem arr(i)
    
28.             Next
    
29.             Me.cmbCompany.ListIndex = 0
    
30.         .Open "GET", "http://www.caac.gov.cn/images/city.js", False
    
31.         .Send
    
32.         arr = Split(执行(BinToStr(.ResponseBody, "GB2312") & "var s='';s=air_cities;"), ",")
    
33.             For i = 1 To UBound(arr) Step 2
    
34.                 d(arr(i)) = arr(i - 1)
    
35.                 Me.cmbDepart.AddItem arr(i)
    
36.                 Me.cmbArrive.AddItem arr(i)
    
37.             Next
    
38.             Me.cmbDepart.ListIndex = Int(Me.cmbDepart.ListCount * Rnd)
    
39.             Me.cmbArrive.ListIndex = Int(Me.cmbArrive.ListCount * Rnd)
    
40.     End With
    
41.     Me.optOneway.Value = True
    
42.     Me.optDirect.Value = True
    
43.     Me.DTPStarDate.Value = Now: Me.DTPRetureDate.Value = Now
    
44. End Sub
    
45. Private Sub btnQuery_Click()
    
46. Dim winHttp As New winHttp.WinHttpRequest, html As New HTMLDocument
    
47. Dim URL As String, Sn As String, strText As String, tb, arr, brr
    
48. Dim i, n, j
    
49.     URL = "http://webflight.linkosky.com/WEB/Flight/WaitingSearch.aspx?"
    
50.     URL = URL & "JT=" & IIf(Me.optOneway, 1, 2) '单程or往返
    
51.     URL = URL & "&OC=" & d(Me.cmbDepart.Text)   '出发地
    
52.     URL = URL & "&DC=" & d(Me.cmbArrive.Text)   '目的地
    
53.     URL = URL & "&dstDesp=GUANGZHOU%B9%E3%D6%DD"
    
54.     URL = URL & "&dst2=CAN"
    
55.     URL = URL & "&DD=" & Format(Me.DTPStarDate.Value, "YYYY-MM-DD")    '查询出发日期
    
56.     URL = URL & "&DT=" & Replace(Me.cmbStartTime.Text, "点", "")    '出发时间点
    
57.     URL = URL & "&BD=" & Format(Me.DTPRetureDate.Value, "YYYY-MM-DD")   '返回日期
    
58.     URL = URL & "&BT=" & Replace(Me.cmbRetureTime.Text, "点", "")   '返回时间点
    
59.     URL = URL & "&AL=" & d(Me.cmbCompany.Text)  '公司
    
60.     URL = URL & "&DR=" & IIf(Me.optDirect.Value, "true", "false")   '是否直达
    
61.     URL = URL & "&image.x=29"
    
62.     URL = URL & "&image.y=7"
    
63.     With winHttp
    
64.         .Open "GET", URL, False
    
65.         .SetRequestHeader "Referer", "http://www.caac.gov.cn/S1/GNCX/"
    
66.         .Send
    
67.         If InStr(.ResponseText, "数据载入中") Then Sn = Split(Split(.ResponseText, "Sn=")(1), "')""")(0) Else MsgBox "网页出错，请重试": Exit Sub
    
68.         URL = Replace(URL & "&Sn=" & Sn, "WaitingSearch", "FlightSearchResultDefault")
    
69.         .Open "GET", URL, False
    
70.         .Send
    
71.         strText = .ResponseText
    
72.     End With
    
73.     If InStr(strText, "抱歉！没有满足条件的航班，请重新输入查询条件") Then
    
74.         MsgBox "抱歉！没有满足条件的航班，请重新输入查询条件！"
    
75.     Else
    
76.         Cells.Clear
    
77.         html.body.innerHTML = strText
    
78.         Set tb = html.all.tags("div")
    
79.         For i = 0 To tb.Length - 1
    
80.             If tb(i).className = "menu_layout2" Or tb(i).className = "listone_layout" Or tb(i).className = "listtwo_layout" Or tb(i).className = "menu_content_small2" Then
    
81.                 n = n + 1
    
82.                 For j = 0 To tb(i).ChildNodes.Length - 1
    
83.                     Cells(n, j + 1) = tb(i).ChildNodes(j).innerText
    
84.                 Next
    
85.             End If
    
86.         Next
    
87.     End If
    
88. End Sub
    
89. Function BinToStr(arrBin, strChrs) '字节集转换,常用编码GBK,GB2312,UTF-8
    
90.     With CreateObject("ADODB.Stream")
    
91.         .Type = 2
    
92.         .Open
    
93.         .WriteText arrBin
    
94.         .Position = 0
    
95.         .Charset = strChrs
    
96.         .Position = 2
    
97.         BinToStr = .Readtext
    
98.         .Close
    
99.     End With
    
100. End Function
     
101. Function 执行(strJS As String)
     
102.   With CreateObject("MSScriptControl.ScriptControl")
     
103.         .Language = "javascript"
     
104.         执行 = .Eval(strJS)
     
105.     End With
     
106. End Function
     

复制代码

[/code]

1. 网抓作业.rar (22.19 KB, 下载次数: 136)
   2014-10-28 22:48 上传

   点击文件名下载附件

复制代码

renahu

renahu 发表于 2014-10-28 19:01
两次send：

Sub Main5()

呵呵，吴老师您终于明白我的意思了，我也是刚发现，原来只要改日期就能看到不同时间的信息了，不用每天都用fiddler去抓了

blanksoul12

不好意思,請問可否說一下,responseBody及responsetext的分別嗎?

onlycxb

1. 不断修改不断完善中！
   
2. 
   
3. Sub 作业1_2_获取航班信息数据()
   
4. '网站：http://www.caac.gov.cn/S1/GNCX/
   
5. '操作：点击“查询”，获取航班信息数据。
   
6.     Dim St As String, Url$, arr, brr, Crr, sntxt
   
7.     Dim S1$, S2$, i%, j%, rng As Range, Flydate As Date
   
8.     Flydate = #11/21/2014#                                                '查询飞行日期
   
9.     '取第一个sn=出现的网址相关数据
   
10.     Url = "http://webflight.linkosky.com/WEB/Flight/WaitingSearch.aspx?JT=1&OC=PEK&DC=SHA&dstDesp=GUANGZHOU%B9%E3%D6%DD&dst2=CAN&DD=" & Format(Flydate, "yyyy-mm-dd") & "&DT=7&BD=&BT=7&AL=ALL&DR=true&image.x=44&image.y=11"
    
11.     With CreateObject("WinHttp.WinHttpRequest.5.1")
    
12. 
    
13.         .Open "GET", Url, False
    
14.         .setRequestHeader "Referer", "http://www.caac.gov.cn/S1/GNCX/"
    
15.         .Send
    
16.         sntxt = Split(Split(.responsetext, "window.location.replace('")(1), "'")(0)
    
17. Debug.Print sntxt
    
18. 
    
19.         .Open "GET", "http://webflight.linkosky.com" & sntxt, False
    
20.         .setRequestHeader "Referer", "http://www.caac.gov.cn/S1/GNCX/"
    
21.         .Send
    
22.         St = .responsetext
    
23.     End With
    
24.     Cells.Clear
    
25.     If InStr(St, "<div id=""FlightListFlight0"">") < 1 Then
    
26.         Cells(1, 1) = "抱歉！没有满足条件的航班，请重新输入查询条件！ "
    
27.     Else
    
28.         St = Split(Split(St, "<div id=""FlightListFlight0"">")(1), "</div><br>")(0)
    
29.         With ActiveSheet
    
30.             Cells(1, 1).Resize(1, 3).Merge
    
31.             Cells(2, 1).Resize(1, 3).Merge
    
32.             Cells(1, 1).Resize(1, 3) = Split(Split(St, "<div class=""menu_layout3""><strong>")(1), "<")(0)    '选择去程（北京首都---上海虹桥）航班
    
33.             Cells(2, 1).Resize(1, 3) = Split(Split(St, "<div class=""layout2_title3"">")(1), "<")(0)          '北京首都至上海虹桥 出发日期：2014-10-28
    
34.             arr = Split(St, "<div class=""menu_layout2"">")
    
35.             For i = 1 To UBound(arr)
    
36.                 S1 = arr(i)
    
37.                 Crr = Split(S1, "<div class=""menu4_layout"">")
    
38.                 ReDim brr(1 To UBound(Crr) - 1 + 3, 1 To 3)                  '
    
39.                 brr(1, 1) = Trim(Split(Split(S1, "<div class=""menu_top1"">")(1), "<")(0))     '航空公司
    
40.                 brr(1, 2) = Trim(Split(Split(S1, "<div class=""menu_top2"">        <strong><span class=""red_font"">")(1), "<")(0))    '航班
    
41.                 brr(1, 3) = Split(Split(S1, "<div class=""menu_top2"">")(2), "<")(0)                 '机型
    
42.                 For j = 2 To UBound(Crr)
    
43.                     S2 = Crr(j)
    
44.                     brr(j, 1) = Split(S2, "</div>")(0)
    
45.                     brr(j, 2) = Split(Split(S2, "<div class=""menu5_layout"">")(1), "</div>")(0)
    
46.                     brr(j, 3) = Split(Split(S2, "<div class=""menu6_layout"">")(1), "</div>")(0)
    
47.                 Next j
    
48.                 Set rng = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
49.                 rng.Resize(UBound(brr, 1), UBound(brr, 2)) = brr
    
50.             Next i
    
51.         End With
    
52.     End If
    
53. End Sub

复制代码

blanksoul12

wcymiss 发表于 2014-10-24 14:04
转码

1、有时我们获取到的数据，有很多乱码。

請問是否和這個 http://club.excelhome.net/thread-1137780-1-1.html 和 http://club.excelhome.net/thread-1161601-1-2.html 情況也應該在 reponsebody 中解決呢?

onlycxb

265楼附件 网抓123 (自动保存的).rar (23.84 KB, 下载次数: 139)

2014-10-28 23:50 上传

点击文件名下载附件

onlycxb

引子玄 发表于 2014-10-28 22:10
“本帖主要针对的是不懂html的网抓新手”————说真话，偶咋就看不懂呢？
不过一直没装fiddler（本人崇尚 ...

徒手擒拿，应该是较高境界，期待示范！

renahu

onlycxb 发表于 2014-10-28 23:41

老师我就没明白为什么要加3呢，就算加上出发经停到达加2就够了，难道还有什么信息我没看见？

renahu

onlycxb 发表于 2014-10-28 23:51
265楼附件

真棒，老师有空再加个录入时间和出发地，目的地选择的命令就完美了