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

wcymiss · 发表于 2014-10-23 16:12

本帖最后由 wcymiss 于 2014-10-30 18:19 编辑

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

比如下面这段代码：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://www.1396me.com/shishicai/", False
.Send
strText = .responsetext
Debug.Print "最新开奖期数："; Left(Split(strText, "<p class=""p"">")(1), 12)
Debug.Print "最新开奖时间："; Left(Split(strText, "<p class=""t"">")(1), 5)
End With
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不会从缓存中调取数据。

wcymiss · 发表于 2014-10-23 23:16

本帖最后由 wcymiss 于 2014-10-24 07:00 编辑

blanksoul12 发表于 2014-10-23 22:56
我直接COPY妳那個程序出來的

晚上正在找重定向的例子进行测试的时候，发现了我电脑winhttp控件居然有个bug。

我的winhttp对于301重定向的网页运行正常，对于302重定向的网页，不管option(6)怎么设置，都不会重定向到新的网页。汗！！

34楼的这个网页，正好是一个302重定向的网页，所以我的winhttp没有进行重定向，返回的信息是原网页的。我还以为option(6)默认是false,测试了才发现默认是true

正确的代码应该还要加一句“.option(6)=false

Sub Main()
Dim strText As String
Dim strCookie As String
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Option(6) = False ' 禁止重定向，以获取原网页信息
.Open "GET", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1", False
.Send
strText = .getAllResponseHeaders '获取所有的回应头信息
Debug.Print strText
strCookie = Split(Split(strText, "JSESSIONID=")(1), ";")(0) '取出Cookie值
.Open "GET", "http://www.gzgczj.com:8080/costRegulatory/project.do?method=showProjectList&isVisitor=1&f_id=11011&t1413902083242", False
.setRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
.setRequestHeader "Cookie", strCookie '模拟Cookie
.Send
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

wcymiss · 发表于 2014-10-23 23:55

本帖最后由 wcymiss 于 2014-10-30 10:05 编辑

重定向

重定向用到的不多，可以稍微了解一下。
你向服务器申请访问地址A，服务器回应你，给你一个新地址B，让你访问它，这就是重定向。（具体请百度）
34楼的例子就是一个重定向的例子。
重定向.png

xmlhttp会自动重定向到B地址，发送B地址的请求。
winhttp有参数可以设置是否重定向：
.Option(6)=false'禁止重定向
.Option(6)=true'允许重定向，默认设置

需要获取重定向之前网页信息的时候，就需要用winhttp设置Option(6)=false来获取了。
比如获取原网页的Cookie。可以参考106楼的代码。

题外话：
发现我电脑有bug：
对于301重定向网页，xmlhttp访问出错，winhttp正常，设置option(6)有效；
对于302重定向网页，xmlhttp可以正常重定向，winhttp不管怎么设置option(6)都无法进行重定向，返回的一直都是原网页信息。
34楼的例子是302重定向。
301重定向例子：http://widget.wumii.com/ext/relatedItemsWidget.htm
我重新下载了一个winhttp.dll也无效。估计是window问题。改天有空重新找个版本GHO

======================================================
经过大师xmyjk的提醒，xmlhttp访问301重定向网页出错的原因是Internet禁止了通过域访问数据源。
Iinternet选项----安全----Internet----自定义级别----其他----通过域访问数据源，选择“启用”即可。

wcymiss · 发表于 2014-10-24 10:03

本帖最后由 wcymiss 于 2014-10-24 10:05 编辑

liucqa 发表于 2014-10-24 09:50
对好多有采集需求的人来说，看看教程，获取数据并不难。难的是不知道如何处理采集到的数据，并生成自己需要 ...

大哥，您老怎么老是看帖看一半啊。。。。

46楼就是模拟cookie欺骗服务器的例子。。。

还有70楼也是。

关于Cookie，我也是尽可能把我所知道的都写出来了。

wcymiss · 发表于 2014-10-24 10:57

代理
如果服务器对同一IP有访问次数的限制，我们就要使用代理服务器了。

winhttp对象有SetProxy方法可以设置代理服务器，具体语句是：

SetProxy 2,"xxx.xxx.xxx.xxx:xxxx"

测试代码(代理服务器地址可能已失效)：

Sub Main()
Dim strText As String
With CreateObject("WinHttp.WinHttpRequest.5.1")
.SetProxy 2, "218.75.100.114:8080"
.Open "GET", "http://20140507.ip138.com/ic.asp", False
.send
strText = ByteToStr(.Responsebody, "GB2312")'请自行拷贝之前的常用函数
Debug.Print strText
End With
End Sub

复制代码

---------------------------------------------------------------
小贴士：
不知大家在测试中发现没，fiddler可以抓到vba中xmlhttp发送请求，但无法抓到winhttp的发送请求。

有时我们调试时，会需要比较代码的发送请求与我们实际操作的发送请求是否一致，但fiddler无法抓到winhttp，怎么办呢？

你当然可以用其他抓包软件抓包。

但更快捷的做法就是，在winhttp中设置代理为"127.0.0.1:8888"。

.SetProxy 2,"127.0.0.1:8888"

复制代码

因为fiddler监视的8888端口，我们设定winhttp的数据由8888进出，fiddler就能抓到包了。

wcymiss · 发表于 2014-10-24 10:59

留空。

wcymiss · 发表于 2014-10-24 12:07

本帖最后由 wcymiss 于 2014-10-24 13:15 编辑

提取数据-下载文件
知道下载文件的真实地址，就能很方便的用xmlhttp或winhttp下载文件。

下载文件同样可以通过fiddler抓包。

打开fiddler，点击下载链接，出现文件下载窗口时点击“取消”即可。

在fiddler里查看抓到的Session前面的图标，文档的下载地址前面的图标一般是图标-文本.png

音乐、图片也都有明确的图标，一看便知。

得到下载地址后，用xmlhttp/winhttp获取文件流（二进制数据），然后把文件流转成文件。

示例代码如下：(注意此时用的是Responsebody而不是Responsetext）

Sub Main()
Const strFileName As String = "C:\测试EH下载文件.rar"
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", "http://club.excelhome.net/forum.php?mod=attachment&aid=MTA2MjQ1MHw0MDQxMTAzOHwxNDE0MTIxNTg0fDIxODkxN3w4MDk5MjQ%3D", False
.Send
ByteToFile .responsebody, strFileName
End With
End Sub

复制代码

小贴士：
1、登录才能下载的文件，真实地址是在登录后服务器临时生成的一个地址。地址得到后，是否登录就无关紧要了。
2、最好事先知道要下载的文件的类型。否则，如果地址中能看出文件类型最好，不然你就只能根据文件结构去判断文件类型了。这个很麻烦。

wcymiss · 发表于 2014-10-24 14:04

本帖最后由 wcymiss 于 2014-11-1 09:17 编辑

转码

1、有时我们获取到的数据，有很多乱码。
这是因为，Responsetext是按照UTF-8的编码格式来解析获取到的数据的，如果数据不是UTF-8编码的字符，就无法正确显示。
这时需要我们获取ResponseBody（这是源生态的没有经过任何编码的数据），然后自行对其进行解析。

比如，116楼例子的网址：http://20140507.ip138.com/ic.asp，因为字符编码是GB2312(charset=gb2312),我们直接显示ResponseText时，中文字符就显示为乱码。

转码1.png

转码最方便的就是利用adostream控件
转码的自定义函数参考11楼代码

2、"\uxxxx"类型的转码
17楼作业中的例子的responsetext包含了很多"\uxxxx"这样的字符，

转码2.png

这是一种unicode格式编码。我们需要对其还原本身的unicode字符。
jscript的unescape就是专门干这个的。

自定义转码函数：

Function unescape(strTobecoded As String) As String
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
unescape = .Eval("unescape('" & strTobecoded & "');")
End With
End Function

复制代码

其实，jscript的eval可以直接转换"\uxxxx"

Function JSEval(s As String) As String
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
JSEval = .Eval(s)
End With
End Function

复制代码

不管是用unescape还是直接Eval，都要注意文本的引号问题。这就好比你在excel的单元格内输入 ="excel" 不会出错，输入 =excel 就会提示出错一样。

3、HTML字符实体的转换
HTML字符实体就是诸如

  "

复制代码

&#20320；///这里应该是半角分号，但我写半角分号发帖时会直接解析为汉字

复制代码

这样的字符串。

例子我暂时还没有找到。
先上转换的自定义函数，因为没找到网页测试，如果有bug请一定告诉我。

Function EnCodeByHTML(strText As String)
With CreateObject("htmlfile")
.write strText
EnCodeByHTML = .body.innertext
End With
End Function

复制代码

4、如果你手头还有其他转码类型，请一定告诉我。

================================================================
有坛友问ResponseBody和ResponseText的区别，这里补充说下：
1、ResponseBody是二进制的数据，是服务器传来的没有经过任何加工的数据。在网络中，文本一般都是以utf-8编码，所以xmlhttp/winhttp对象的ResponseText是按照utf-8编码把ResponseBody转换而成，也就是：ResponseText=ByteToStr(ResponseBody,"UTF-8")
至于问“为什么ByteToStr(ResponseText,"GB2312")没有结果”，原因是：一是参数类型不对，ByteToStr的第一参数是二进制数据的Byte数组类型，ResponseText是文本类型，系统提示出错；二是，即使进行了将文本转成二进制数据的转换（如下面代码里的b7=s这样的转换），这种转换也是按照某种编码进行的，这样的二进制已经进行过一次编码加工了，你再用ByteToStr就得不到原来的字符了。

2、对于StrConv和BytetoStr有什么区别，可以测试下面的代码：

Sub Test()
Const s As String = "a我"
Dim b1() As Byte, b2() As Byte, b3() As Byte, b4() As Byte, b5() As Byte, b6() As Byte, b7() As Byte
b1 = StrToByte(s, "GB2312")
b2 = StrConv(s, vbFromUnicode) '系统默认
b3 = StrConv(s, vbFromUnicode, "2052") '内地中文
b4 = StrConv(s, vbFromUnicode, "1028") '台湾中文
b5 = StrToByte(s, "BIG5")
b6 = StrConv(s, vbUnicode)
b7 = s
Stop '查看本地窗口里以上几个变量
End Sub

复制代码

有兴趣的还可以看看asc、ascw、chr、chrw这几个函数。

wcymiss · 发表于 2014-10-25 09:05

本帖最后由 wcymiss 于 2014-10-26 10:10 编辑

处理数据的通用方法：

1、数组法：
用split和数组，循环将所需数据取出。
优点：不需其他对象辅助，起点低，会数组即可。
缺点：需要分析数据结构，对于复杂结构的数据，需要多步才能完成。
以作业一的第1题为例：

Sub Main()
Dim strText As String
Dim arrRow, arrCell
Dim i As Long, j As Long, n As Long
Dim arrColumn
Dim arrData(1 To 1000, 1 To 10)
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://data.bank.hexun.com/lccp/jrxp.aspx", False
.Send
strText = .responsetext
End With
arrColumn = Array(, , 9, 12, 14, 16, 18, 20, 22, 24, 26)
arrRow = Split(strText, "name='proTest' ")
For i = 1 To UBound(arrRow)
arrCell = Split(arrRow(i), ">")
n = n + 1
arrData(n, 1) = Split(Split(arrCell(0), "value='")(1), "'")(0)
For j = 2 To 10
arrData(n, j) = Split(arrCell(arrColumn(j)), "<")(0)
Next
Next
Cells.Clear
Range("a1:j1").Value = Split("产品名称是否在售银行起售日停售日币种管理期(月) 产品类型预期收益(%) 收益类型", " ")
Range("a2").Resize(n, 10).Value = arrData
End Sub

复制代码

2、正则法：
用正则拆解字符串，提取匹配数据，循环取出。
优点：即便复杂结构的数据，也有可能一步到位。
缺点：需要学习正则知识。
70楼获取到QQ群成员清单后，用正则提取成员的昵称和QQ号：

Sub Main()
Const gc As String = "" '群号
Const bkn As String = "" '从fiddler中获取
Const uin As String = "" 'QQ号
Const skey As String = "" '从fiddler中获取
Dim strText As String
Dim RegMatch As Object
Dim arrData(1 To 1000, 1 To 2)
Dim n As Long
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", "http://qinfo.clt.qq.com/cgi-bin/qun_info/get_group_members_new?gc=" & gc & "&bkn=" & bkn, False
.setRequestHeader "Cookie", "uin=o" & uin & "; skey=" & skey
.Send
strText = .responsetext
Debug.Print strText
End With
With CreateObject("VBScript.Regexp")
.Global = True
.Pattern = "{""b"":\d+,""g"":\d+,""n"":""([^""]*)"",""u"":(\d+)}"
For Each RegMatch In .Execute(strText)
n = n + 1
arrData(n, 1) = RegMatch.submatches(0)
arrData(n, 2) = RegMatch.submatches(1)
Next
End With
Set RegMatch = Nothing
Cells.Clear
Range("a1:b1").Value = Array("昵称", "QQ号")
Range("a2").Resize(n, 2).Value = arrData
End Sub

复制代码

以上两种方法对于处理获取到的数据一般都能用，但都需先行分析获数据结构。对于复杂结构数据，需要时间和耐心。

table、xml、json各自还有一些专用的提取方法。

wcymiss · 发表于 2014-10-25 10:43

本帖最后由 wcymiss 于 2014-10-27 13:07 编辑

处理table
table数据处理，除了之前的两种通用方法外，还有以下几种方法：

1、html法
将table数据写入htmldocument对象，然后循环取出表格的各个元素。
优点：可以利用htmldocument对象整理表格。
缺点：需要学习html相关知识。
以17楼作业二为例：

Sub Main()
Dim strText As String
Dim arrData(1 To 1000, 1 To 3)
Dim i As Long, j As Long
Dim TR As Object, TD As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
.setRequestHeader "Content-Type", "application/json"
.Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"
strText = Split(JSEval(.responsetext), "<script")(0) '本例的script运行会提示错误，所以去除这部分script代码
End With
With CreateObject("htmlfile")
.write strText
i = 0
For Each TR In .all.tags("table")(2).Rows
i = i + 1
j = 0
For Each TD In TR.Cells
j = j + 1
arrData(i, j) = TD.innerText
Next
Next
End With
Set TR = Nothing
Set TD = Nothing
Cells.Clear
Range("C:C").NumberFormat = "@" '设置文本格式以显示数字前面的0
Range("a1").Resize(i, 3).Value = arrData
End Sub
Function JSEval(s As String) As String
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
JSEval = .Eval(s)
End With
End Function

复制代码

2、QueryTable法：
这个是excel自带的网抓利器。个人觉得它最大的优势就是处理table很方便。
优点：处理table方便，代码简短。
缺点：会产生定义名称。多页循环时每页都会产生行字段名称，需要后续处理删除。
仍以作业一的第1题为例：

Sub Main()
Cells.Delete
With ActiveSheet.QueryTables.Add("url;http://data.bank.hexun.com/lccp/jrxp.aspx", Range("a1"))
.WebFormatting = xlWebFormattingNone '不包含格式
.WebSelectionType = xlSpecifiedTables '指定table模式
.WebTables = "2" '第2张table
.Refresh False
End With
End Sub

复制代码

代码相当简短。

3、复制粘贴法：
table部分的文字可以直接复制到单元格内，且保留数据原格式。
优点：只需取出table部分，不需分析数据内部结构。代码编写简便。
缺点：有时格式反而是累赘。

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://data.bank.hexun.com/lccp/jrxp.aspx", False
.Send
strText = .responsetext
End With
strText = "<table" & Split(Split(strText, "<table")(2), "</table>")(0) & "</table>"
CopyToClipbox strText
Cells.Clear
Range("a1").Select
ActiveSheet.Paste
End Sub
Sub CopyToClipbox(strText As String)
'文本拷贝到剪贴板
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
End Sub

复制代码

小贴士：
点击Fiddler的Response框的WebView按钮可以看到HTML代码在网页上的显示效果。

		自动登录	找回密码
密码			免费注册

[原创] 不懂html也来学网抓（xmlhttp/winhttp+fiddler）

点评

评分

点评

点评

评分

评分

评分

最新热点 /1