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

战战如疯

onlycxb 发表于 2014-10-26 19:44
之前取网页是如何取全部页共280条记录的？求分享。

看到你在另一个帖子上的回复了，就是抓网址，page翻页也可以，你抓的那个更方便

suwenkai

战战如疯 发表于 2014-10-26 14:59
下面应该是Json了吧，之前做的一个网页，用html和split能处理，心血来潮想学习下Json，但是这个网页的Json好 ...

okko.rar (24.39 KB, 下载次数: 96)

2014-10-26 22:52 上传

点击文件名下载附件

换一种方法下载数据，哪个页面有下载excel的功能，捕捉数据后发送出来的效果。

1. Sub 按钮1_单击()
   
2.     Dim url, html, js, xml
   
3.     Set xml = CreateObject("MSXML2.DomDocument")
   
4.     url = "http://www.okooo.com/soccer/match/680903/odds/download/"
   
5.     PD = "MatchID=1250203"
   
6.     PD = PD & "&MakerIDList="
   
7.     PD = PD & "24,2,14,82,27,43,25,94,65,35,36,37,180,159,19,84,17,116,"
   
8.     PD = PD & "126,150,49,157,168,170,285,286,307,250,220,280,131,322,197,715,"
   
9.     PD = PD & "406,594,578,516,88,237,505,89,370,90,633,694,373,706,644,586,"
   
10.     PD = PD & "78,238,590,331,416,491,428,704,700,683,634,98,481,461,482,494,"
    
11.     PD = PD & "294,100,564,602,223,268,565,13,642,493,479,198,666,409,418,79,"
    
12.     PD = PD & "548,242,29,545,394,74,243,376,459,697,298,245,105,643,636,543,"
    
13.     PD = PD & "106,458,531,413,108,629,335,31,681,214,112,437,301,679,640,114,"
    
14.     PD = PD & "645,705,522,33,118,668,270,337,571,211,408,526,572,340,561,677,"
    
15.     PD = PD & "419,563,341,38,125,490,391,532,434,432,246,649,635,499,455,390,"
    
16.     PD = PD & "674,597,709,40,513,130,210,672,470,454,473,518,42,630,496,344,"
    
17.     PD = PD & "483,554,647,651,400,593,386,538,669,142,143,275,276,385,348,260,"
    
18.     PD = PD & "652,147,148,149,708,489,653,587,675,485,632,581,152,310,329,486,"
    
19.     PD = PD & "687,325,247,50,698,696,487,654,655,232,650,313,52,209,627,517,"
    
20.     PD = PD & "523,648,162,661,281,160,404,161,316,355,59,641,659,166,60,233,"
    
21.     PD = PD & "701,444,712,471,62,234,662,529,360,405,216,584,283,254,441,596,"
    
22.     PD = PD & "284,472,174,207,637,558,175,362,363,542,492,567,568,182,364,183,"
    
23.     PD = PD & "365,591,319,702,235,187,519,552,289,320,474,615,609,608,619,598,"
    
24.     PD = PD & "613,622,599,611,616,614"
    
25.     Set html = CreateObject("htmlfile")
    
26.     Set js = CreateObject("scriptcontrol")
    
27.     js.Language = "jscript"
    
28.     With CreateObject("msxml2.xmlhttp")
    
29.         .Open "POST", url, False
    
30.         .setRequestHeader "Host", "www.okooo.com"
    
31.         .setRequestHeader "Connection", "keep-alive"
    
32.         .setRequestHeader "Content-Length", "1740"
    
33.         .setRequestHeader "Cache-Control", "max-age=0"
    
34.         .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
    
35.         .setRequestHeader "Origin", "http://www.okooo.com"
    
36.         .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/38.0.2125.104 Safari/537.36"
    
37.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
38.         .setRequestHeader "Referer", "http://www.okooo.com/soccer/match/680903/odds/"
    
39.         .setRequestHeader "Accept-Encoding", "gzip,deflate"
    
40.         .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    
41. 
    
42.         .send (PD)
    
43.         s = .responsetext
    
44.         xml.loadxml (s)
    
45.       
    
46.         Set t = xml.childnodes(2).childnodes(3).childnodes(0).childnodes
    
47.         
    
48.         slen = t.Length - 1
    
49.         
    
50.         For i = 0 To slen
    
51.             sslen = t(i).childnodes.Length - 1
    
52.             For j = 0 To sslen
    
53.                 Cells(i + 1, j + 1) = t(i).childnodes(j).Text
    
54.             Next
    
55.         Next
    
56.     End With
    
57. End Sub
    

复制代码

bailanhong

bailanhong 发表于 2014-10-25 16:23
我的“body”里为什么是空白的呢？

我是照着你的例子来操作的，我再检查下

此用户被禁言

不明白为什么，使用IE对象与msxml2对象的时候，表格不一样
这个是在第二个

1. Sub 作业()
   
2.     Dim url, html
   
3.     Set html = CreateObject("htmlfile")
   
4.     url = "http://data.bank.hexun.com/lccp/Jrxp.aspx?col=1&tag=desc&date=2014-10-26&page="
   
5.     With CreateObject("msxml2.xmlhttp")
   
6.         For p = 1 To 3
   
7.             .Open "POST", url & p, False
   
8.             .send
   
9.             html.body.innerhtml = .responsetext
   
10.             Set tb = html.all.tags("table")(1).Rows
    
11.             For i = 0 To tb.Length - 1
    
12.                 n = n + 1
    
13.                 For j = 0 To tb(i).Cells.Length - 1
    
14.                     Cells(n, j + 1) = tb(i).Cells(j).innertext
    
15.                 Next
    
16.             Next
    
17.         Next
    
18.     End With
    
19. End Sub

复制代码

IE的是在第3个

1. Sub 作业3() 'ie
   
2.     Set ie = CreateObject("internetexplorer.application")
   
3.     ie.navigate "http://data.bank.hexun.com/lccp/Jrxp.aspx?col=1&tag=desc&date=2014-10-26&page=1"  '没有循环，只是看表在第几个
   
4.     ie.Visible = True
   
5.     Do While ie.ReadyState <> 4
   
6.         DoEvents
   
7.     Loop
   
8.     Set a_s = ie.Document.all.tags("table")(2).Rows   ''''''''''这是不同，msxml2这个表后面要填写数字1
   
9.             For i = 0 To a_s.Length - 1
   
10.                  n = n + 1
    
11.                   For j = 0 To a_s(i).Cells.Length - 1
    
12.                     Cells(n, j + 1) = a_s(i).Cells(j).innertext
    
13.                   Next
    
14.              Next
    
15.     MsgBox "数据抓取已经完成", 0 + 64, "此用户被禁言提示"
    
16. End Sub
    

复制代码

不明白为什么。。。表格在的位置不一样，

bailanhong

非常感谢！！！吴姐，什么时候能不能也讲讲Split函数和Ubound，你讲的很容易懂！！

onlycxb

suwenkai 发表于 2014-10-26 22:50
换一种方法下载数据，哪个页面有下载excel的功能，捕捉数据后发送出来的效果。

这是按照ID输出?

onlycxb

suwenkai 发表于 2014-10-26 22:50
换一种方法下载数据，哪个页面有下载excel的功能，捕捉数据后发送出来的效果。

综合183楼代码,利用页面下载功能,输出全部数据.(代码仅是简单组合,未整理,可实现效果)

1. Sub 按钮1_单击()
   
2.     Dim url, html, js, xml
   
3.     Cells.Clear
   
4.     Dim tt As String, winhttp, t1, arr, i, v
   
5.     Dim PDstr As String
   
6.     '取数据ID号
   
7.     Set winhttp = CreateObject("Microsoft.XMLHTTP")
   
8.     With winhttp
   
9.         .Open "GET", "http://www.okooo.com/soccer/match/680903/odds/ajax/?page=0&all=1&companytype=BaijiaBooks&type=1 ", False
   
10.         .send
    
11.         t1 = .responsetext
    
12.         i = 1
    
13.         arr = Split(Split(Split(t1, "data_str = '")(1), "';var pageData")(0), "';")
    
14.         strJSON = arr(0)
    
15.         Set objSC = CreateObject("ScriptControl")
    
16.         objSC.Language = "JScript"
    
17.         strFunc = "function getjson(s) { return eval('(' + s + ')'); }"
    
18.         objSC.AddCode strFunc
    
19.         Set objJSON = objSC.CodeObject.getjson(strJSON)
    
20.         For Each v In objJSON
    
21.             PDstr = PDstr & "," & v.MakerID
    
22.         Next
    
23.         PDstr = Mid(PDstr, 2)
    
24.     End With
    
25.   '输出
    
26.     Set xml = CreateObject("MSXML2.DomDocument")
    
27.     url = "http://www.okooo.com/soccer/match/680903/odds/download/"
    
28.     PD = "MatchID=1250203"
    
29.     PD = PD & "&MakerIDList=" & PDstr
    
30.     Set html = CreateObject("htmlfile")
    
31.     Set js = CreateObject("scriptcontrol")
    
32.     js.Language = "jscript"
    
33.     With CreateObject("msxml2.xmlhttp")
    
34.         .Open "POST", url, False
    
35.         .setRequestHeader "Host", "www.okooo.com"
    
36.         .setRequestHeader "Connection", "keep-alive"
    
37.         .setRequestHeader "Content-Length", "1740"
    
38.         .setRequestHeader "Cache-Control", "max-age=0"
    
39.         .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
    
40.         .setRequestHeader "Origin", "http://www.okooo.com"
    
41.         .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/38.0.2125.104 Safari/537.36"
    
42.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
43.         .setRequestHeader "Referer", "http://www.okooo.com/soccer/match/680903/odds/"
    
44.         .setRequestHeader "Accept-Encoding", "gzip,deflate"
    
45.         .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
    
46.         .send (PD)
    
47.         s = .responsetext
    
48.         xml.loadxml (s)
    
49.         Set t = xml.childnodes(2).childnodes(3).childnodes(0).childnodes
    
50. 
    
51.         slen = t.Length - 1
    
52. 
    
53.         For i = 0 To slen
    
54.             sslen = t(i).childnodes.Length - 1
    
55.             For j = 0 To sslen
    
56.                 Cells(i + 1, j + 1) = t(i).childnodes(j).Text
    
57.             Next
    
58.         Next
    
59.     End With
    
60. End Sub

复制代码

onlycxb

进一步精简187楼

1. Sub 按钮1_单击()
   
2.     Dim url, html, js, xml
   
3.     Cells.Clear
   
4.     Dim tt As String, winhttp, t1, arr, i, v
   
5.     Dim PDstr As String
   
6.     '取数据ID号
   
7.     Set winhttp = CreateObject("Microsoft.XMLHTTP")
   
8.     With winhttp
   
9.         .Open "GET", "http://www.okooo.com/soccer/match/680903/odds/ajax/?page=0&all=1&companytype=BaijiaBooks&type=1 ", False
   
10.         .send
    
11.         t1 = .responsetext
    
12.         i = 1
    
13.         arr = Split(Split(Split(t1, "data_str = '")(1), "';var pageData")(0), "';")
    
14.         strJSON = arr(0)
    
15.         Set objSC = CreateObject("ScriptControl")
    
16.         objSC.Language = "JScript"
    
17.         strFunc = "function getjson(s) { return eval('(' + s + ')'); }"
    
18.         objSC.AddCode strFunc
    
19.         Set objJSON = objSC.CodeObject.getjson(strJSON)
    
20.         For Each v In objJSON
    
21.             PDstr = PDstr & "," & v.MakerID
    
22.         Next
    
23.         PDstr = Mid(PDstr, 2)
    
24.     End With
    
25.   '输出
    
26.     Set xml = CreateObject("MSXML2.DomDocument")
    
27.     url = "http://www.okooo.com/soccer/match/680903/odds/download/"
    
28.     PD = "MatchID=1250203"
    
29.     PD = PD & "&MakerIDList=" & PDstr
    
30.     Set html = CreateObject("htmlfile")
    
31.     Set js = CreateObject("scriptcontrol")
    
32.     js.Language = "jscript"
    
33.     With CreateObject("msxml2.xmlhttp")
    
34.         .Open "POST", url, False
    
35.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
36.         .setRequestHeader "Referer", "http://www.okooo.com/soccer/match/680903/odds/"
    
37.         .send (PD)
    
38.         s = .responsetext
    
39.         xml.loadxml (s)
    
40.         Set t = xml.childnodes(2).childnodes(3).childnodes(0).childnodes
    
41. 
    
42.         slen = t.Length - 1
    
43. 
    
44.         For i = 0 To slen
    
45.             sslen = t(i).childnodes.Length - 1
    
46.             For j = 0 To sslen
    
47.                 Cells(i + 1, j + 1) = t(i).childnodes(j).Text
    
48.             Next
    
49.         Next
    
50.     End With
    
51. End Sub

复制代码

VBA万岁

wcymiss 发表于 2014-10-26 09:42
处理xml数据
8楼的例子返回的就是一个xml文档。

抓包response数据如附件：
抓包response数据.rar (345.66 KB, 下载次数: 216)

2014-10-27 18:37 上传

点击文件名下载附件

onlycxb

VBA万岁 发表于 2014-10-27 09:19
抓包response数据如附件：

学习很刻苦，赏花