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

wcymiss

缓存的困扰
用xmlhttp对象GET数据时，会优先从缓存中调取。

比如下面这段代码：

1. Sub Main()
   
2.     Dim strText As String
   
3.     With CreateObject("MSXML2.XMLHTTP")
   
4.         .Open "GET", "http://www.1396me.com/shishicai/", False
   
5.         .Send
   
6.         strText = .responsetext
   
7.         Debug.Print "最新开奖期数："; Left(Split(strText, "<p class=""p"">")(1), 12)
   
8.         Debug.Print "最新开奖时间："; Left(Split(strText, "<p class=""t"">")(1), 5)
   
9.     End With
   
10. End Sub

复制代码

运行后，不要关闭该excel，过10分钟再运行，仍然出现之前的结果，数据没有更新。但网页上已有更新。

这种现象是因为xmlhttp调用了缓存的数据。

这个缓存不是指浏览器的缓存，而是excel的缓存。不信你清除浏览器的缓存试试，代码结果仍然不会更新。

这个缓存随excel的进程结束而消失。

所以我们在网抓的调试中，为了验证一段代码能否真正获取到数据，除了清除浏览器的Cookie缓存种种，还必须关闭excel再重新打开excel后再运行代码。这时的运行结果才是代码的真正结果。

那么，除了关闭excel，有没有其他方法能避免这样的现象呢？

回答当然是“有”，而且有多种方法可以避免xmlhttp调用缓存的数据。

方法如下：

1、在URL后面添加随机参数。
   比如上述代码中，我们把Open语句改成：
   .Open "GET", "http://www.1396me.com/shishicai/?=" & Rnd(), False   然后代码就能实时更新了。

   这个方法最简单，但它未必对所有的网页适用。

2、添加setRequestHeader
   在代码的Send语句前加一句：
   .setRequestHeader "If-Modified-Since", "0"
   这句语句的具体含义请百度。在这里我们用它使代码效果实时更新。
   同样，未必对所有的网页都适用，而且效率比上种方法低下。

3、用winhttp代替xmlhttp
   winhttp不会从缓存中调取数据。

blanksoul12

不好意思,關於34樓的單獨拿取COOKIE那個練習,我不能單獨取出COOKIE來,請問有什麼問題呢?

Sukey33

必须马住！

onlycxb

wcymiss 发表于 2014-10-21 15:20
新手作业：
网站：http://www.pinble.com/Lottery.htm
操作：点击“各省体彩”---“江苏七星彩”，获取江 ...

新手作业

1. Sub 江苏七星彩()
   
2.     Dim objhq As New WinHttp.WinHttpRequest
   
3.     Dim STxt As String, Url As String, i As Integer, j As Integer
   
4.     Dim Pages As Integer, Pstr As String, arr, brr, rng As Range
   
5.     Cells.Clear
   
6.     With objhq
   
7.         .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
   
8.         .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
   
9.         .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
   
10.         .Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
    
11.         STxt = .ResponseText
    
12.     End With
    
13.     STxt = UTF8toChineseCharacters(STxt)                                                           'J3编码
    
14.     Pages = Split(Split(Split(STxt, "分页")(1), "页")(0), "/")(1)
    
15. 
    
16.     '循环各页取数，下面以取2页为例 ，实际总页数Pages
    
17.     For i = 1 To 2
    
18.         With objhq
    
19.             .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
    
20.             .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
    
21.             .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
    
22.             .Send "{pageindex:'" & i & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
    
23.             STxt = UTF8toChineseCharacters(.ResponseText)
    
24.         End With
    
25. 
    
26.         Cells(1, 1) = "江苏七星彩 开奖信息": Cells(1, 2) = "开奖周期：周二、周四、周五、周日"
    
27.         Cells(2, 1).Resize(1, 3) = Array("开奖时间", "期号", "开奖号码")
    
28.         Pstr = "<tr style='backgro%und-color: White; border-color: #B6CBE8;'>"
    
29.         arr = Split(STxt, Pstr)
    
30.         ReDim brr(1 To UBound(arr) - 1, 1 To 3)
    
31.         For j = 1 To UBound(arr) - 1
    
32.             brr(j, 1) = Split(Split(arr(j), "</td>")(0), ">")(1)
    
33.             brr(j, 2) = Split(Split(arr(j), "</td>")(1), ">")(1)
    
34.             brr(j, 3) = Split(Split(Split(arr(j), "</td>")(2), "</span>")(0), "ctl02_lblHao'>")(1)
    
35.         Next j
    
36.         Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
37.         rng.Resize(UBound(brr, 1), 3) = brr
    
38.     Next i
    
39.     Columns("A:A").NumberFormatLocal = "yyyy-m-d"
    
40.     Columns("B:C").NumberFormatLocal = "@"
    
41.     Columns("A:C").EntireColumn.AutoFit
    
42. End Sub
    
43. Function UTF8toChineseCharacters(szInput)
    
44.     With CreateObject("MSScriptControl.ScriptControl")
    
45.     .Language = "JavaScript"
    
46.     .AddCode "function decode(str){return unescape(str.replace(/\u/g,'%u'));}"
    
47.     UTF8toChineseCharacters = .Eval("decode('" & szInput & "')")
    
48.     End With
    
49. End Function
    

复制代码

补充内容 (2014-11-1 17:50):
\u是J3

onlycxb

wcymiss 发表于 2014-10-21 15:20
新手作业：
网站：http://www.pinble.com/Lottery.htm
操作：点击“各省体彩”---“江苏七星彩”，获取江 ...

新手作业

1. Sub 江苏七星彩()
   
2.     Dim objhq As New WinHttp.WinHttpRequest
   
3.     Dim STxt As String, Url As String, i As Integer, j As Integer
   
4.     Dim Pages As Integer, Pstr As String, arr, brr, rng As Range
   
5.     Cells.Clear
   
6.     With objhq
   
7.         .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
   
8.         .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
   
9.         .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
   
10.         .Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
    
11.         STxt = .ResponseText
    
12.     End With
    
13.     STxt = UTF8toChineseCharacters(STxt)                                                           'J3编码
    
14.     Pages = Split(Split(Split(STxt, "分页")(1), "页")(0), "/")(1)
    
15. 
    
16.     '循环各页取数，下面以取2页为例 ，实际总页数Pages
    
17.     For i = 1 To 2
    
18.         With objhq
    
19.             .Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
    
20.             .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
    
21.             .SetRequestHeader "Referer", "http://www.pinble.com/Lottery.htm"
    
22.             .Send "{pageindex:'" & i & "',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
    
23.             STxt = UTF8toChineseCharacters(.ResponseText)
    
24.         End With
    
25. 
    
26.         Cells(1, 1) = "江苏七星彩 开奖信息": Cells(1, 2) = "开奖周期：周二、周四、周五、周日"
    
27.         Cells(2, 1).Resize(1, 3) = Array("开奖时间", "期号", "开奖号码")
    
28.         Pstr = "<tr style='backgro%und-color: White; border-color: #B6CBE8;'>"
    
29.         arr = Split(STxt, Pstr)
    
30.         ReDim brr(1 To UBound(arr) - 1, 1 To 3)
    
31.         For j = 1 To UBound(arr) - 1
    
32.             brr(j, 1) = Split(Split(arr(j), "</td>")(0), ">")(1)
    
33.             brr(j, 2) = Split(Split(arr(j), "</td>")(1), ">")(1)
    
34.             brr(j, 3) = Split(Split(Split(arr(j), "</td>")(2), "</span>")(0), "ctl02_lblHao'>")(1)
    
35.         Next j
    
36.         Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
37.         rng.Resize(UBound(brr, 1), 3) = brr
    
38.     Next i
    
39.     Columns("A:A").NumberFormatLocal = "yyyy-m-d"
    
40.     Columns("B:C").NumberFormatLocal = "@"
    
41.     Columns("A:C").EntireColumn.AutoFit
    
42. End Sub
    
43. Function UTF8toChineseCharacters(szInput)
    
44.     With CreateObject("MSScriptControl.ScriptControl")
    
45.     .Language = "JavaScript"
    
46.     .AddCode "function decode(str){return unescape(str.replace(/\u/g,'%u'));}"
    
47.     UTF8toChineseCharacters = .Eval("decode('" & szInput & "')")
    
48.     End With
    
49. End Function
    

复制代码

onlycxb

这讲课速度也太快了。

renahu

VBA万岁 发表于 2014-10-22 12:33
ie法完成作业1：
Sub 今日在售银行产品()
'On Error Resume Next

这个怎么提示“445”错误，说对象不支持该动作

VBA万岁

renahu 发表于 2014-10-23 16:59
这个怎么提示“445”错误，说对象不支持该动作

将'On Error Resume Next
前面的逗号去掉看看。

VBA万岁

wcymiss 发表于 2014-10-23 16:12
缓存的困扰
用xmlhttp对象GET数据时，会优先从缓存中调取。

明天继续学习......

blanksoul12

blanksoul12 发表于 2014-10-23 16:24
不好意思,關於34樓的單獨拿取COOKIE那個練習,我不能單獨取出COOKIE來,請問有什麼問題呢?

在34樓第三點時,運行到 Debug.Print strText 這句後看即時窗時,只發現
Date: Thu, 23 Oct 2014 09:41:30 GMT
Transfer-Encoding: chunked
Content-Type: text/html;charset=UTF-8
Server: Apache-Coyote/1.1
所以到之後這句 strCookie = Split(Split(strText, "JSESSIONID=")(1), ";")(0) 時便出現 ERROR 了