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

wcymiss · 发表于 2014-10-21 13:19

本帖最后由 wcymiss 于 2014-11-1 16:44 编辑

常用代码及自定义函数：

1、网抓主体代码：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")'
.Open "POST", "", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", ""
.Send
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

代码里的很多""就是留给你的填空题。。。
xmlhttp/winhttp对象的属性和方法可以网上百度学习（不学也暂时影响不大），内容不多。

2、Javascript表达式求值：

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

复制代码

3、url转码：

Function encodeURI(strText As String) As String
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
encodeURI = .Eval("encodeURIComponent('" & strText & "');")
End With
End Function

复制代码

javascript提供了六个转码函数：
escape，unescape，encodeURI，encodeURIComponent，decodeURI，decodeURIComponent
具体用法请百度。我只能说我最常用的是encodeURIComponent。

4、流数据转成指定编码的文本：

Function ByteToStr(arrByte, strCharset As String) As String
With CreateObject("Adodb.Stream")
.Type = 1 'adTypeBinary
.Open
.Write arrByte
.Position = 0
.Type = 2 'adTypeText
.Charset = strCharset
ByteToStr = .Readtext
.Close
End With
End Function

复制代码

5、文本按指定编码转为流数据：

Function StrToByte(strText As String, strCharset As String)
With CreateObject("adodb.stream")
.Mode = 3 'adModeReadWrite
.Type = 2 'adTypeText
.Charset = strCharset
.Open
.Writetext strText
.Position = 0
.Type = 1 'adTypeBinary
'.Position = 2 '保留BOM头则不需此行代码，去除三个字节的BOM头就填入3，去除两个字节的就填入2
StrToByte = .Read
.Close
End With
End Function

复制代码

注：某些文本转为流后，前面会添加几个字节的BOM头，用来被某些软件识别是什么编码。如UTF-8编码的前面有三个字节的BOM头，Unicode前面有两个字节的BOM头。大家可以视情况选择保留或去除这些BOM头。
6、二进制流转成文件：

Sub ByteToFile(arrByte, strFileName As String)
With CreateObject("Adodb.Stream")
.Type = 1 'adTypeBinary
.Open
.Write arrByte
.SaveToFile strFileName, 2 'adSaveCreateOverWrite
.Close
End With
End Sub

复制代码

7、文本拷贝到剪贴板：

Sub CopyToClipbox(strText As String)
'文本拷贝到剪贴板
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
End Sub

复制代码

先上这些，以后觉得有必要再添加

呃，原谅我吧，我是个怀旧的人。我的机器的配置目前为止仍旧是32位的winXP+2003office，IE也刚升级到IE8，之前一直用的IE6。弦月大师（xmyjk）所点评的内容我没有办法提供呀。。甩泪。。。

=================================================
突然想起HtmlWindow也可以直接执行Javascript函数得出值。
用64位office的朋友可以测试一下下面的代码能不能通过：
替代上面自定义函数2的：

Function EvalByHtml(strText As String) As String
With CreateObject("htmlfile")
.write "<html><script></script></html>"
EvalByHtml = CallByName(.parentwindow, "eval", VbMethod, strText)
End With
End Function

复制代码

替代上面自定义函数3的：

Function encodeURIByHtml(strText As String) As String
With CreateObject("htmlfile")
.write "<html><script></script></html>"
encodeURIByHtml = CallByName(.parentwindow, "encodeURIComponent", VbMethod, strText)
End With
End Function

复制代码

给Dom添加一个空的script就可以直接执行js函数了，非常好用。

为防止vba自动篡改大小写，把js函数名作为文本放在callbyname的参数里。

无姓人 · 发表于 2014-10-21 13:55

感谢分享！！努力学习！！！！！！！

wcymiss · 发表于 2014-10-21 14:00

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

获取数据-直接获取-GET

再复制一次主体代码：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", ""
.Send
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

xmlhttp/winhttp对象的Open方法的第一参数主要有两个值：GET 和 POST。（必须大写）

如何知道应该用GET还是POST呢？很简单，看之前用fiddler的数据网页的Request框Raw里的内容（仍然用8楼的例子）：

Raw里是“GET”，所以我们代码也用“GET”，Open方法的第二参数写入GET后面的Url
后面的setRequestHeader语句暂且注释掉。
这样代码就写好了：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", "http://www.cffex.com.cn/fzjy/tjsj/pztj/pzrtj/2014/index.xml", False
' .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' .setRequestHeader "Referer", ""
.Send
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

运行下，查看立即窗口的结果：

数据成功获取。

本例是最直接的GET，不需添加setRequestHeader。

小贴士：
复制Request框内的Url时，为避免打开该链接，可以点击Request框右下角的“View in Notepad”按钮，从记事本内复制。

又：ResponseText在vba的立即窗口显示不全的原因是立即窗口只能容纳有限长度的文本。文本超长后，只能显示后面一部分的内容。

wcymiss · 发表于 2014-10-21 14:13

本帖最后由 wcymiss 于 2014-10-22 12:35 编辑

新手作业：
1、网站：http://data.bank.hexun.com/lccp/jrxp.aspx
操作：点击“今日在售产品”，获取今日在售产品第一页的数据。

2、网站：http://www.caac.gov.cn/S1/GNCX/
操作：点击“查询”，获取航班信息数据。

作业说明：因为仅仅是练习fiddler的使用以及最基本网抓代码的写法，所以代码只需在ResponseText获取到所需数据就行了。不需要整理，也不必考虑动态参数的问题。

wcymiss · 发表于 2014-10-21 14:29

本帖最后由 wcymiss 于 2014-10-21 16:01 编辑

获取数据-直接获取-POST

Open第一参数是“POST"的时候，Send方法一般会有参数。

举例：
网站：http://cn.zso8.com/odds/search/
操作：第一行，“联赛选择”内选择“英超”，然后点击最右边的“确定”，获取该数据。

用fiddler找到数据页面，查看Request框Raw里的内容：

同之前一样，填入“POST”，填入URL。然后，复制“type=2&CompanyID.......”这部分字符串，作为Send的参数。
代码成型：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "http://cn.zso8.com/odds/search/", False
' .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' .setRequestHeader "Referer", ""
.Send "type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A"
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

运行。。。。然后发现，没有成功！

立即窗口没有数据：

Response框里是有数据的：

为什么没有成功呢？因为没有模拟setRequestHeader！
经验：“POST”时，一般都需要模拟setRequestHeader的“Content-Type”字段（Header）。

再回头，拷贝出Request中的Content-Type后面的值：application/x-www-form-urlencoded，填入代码中。

第二次成型代码：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "http://cn.zso8.com/odds/search/", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' .setRequestHeader "Referer", ""
.Send "type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A"
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

运行，查看立即窗口，这次有数据了：

小贴士：
Content-Type后面的值大部分都是application/x-www-form-urlencoded，但也有些网页不是这样的内容。每次代码模拟一定要和Request框内的内容保持一致，不要掉以轻心。

onlycxb · 发表于 2014-10-21 15:19

来晚了。先占个听课板凳！

wcymiss · 发表于 2014-10-21 15:20

本帖最后由 wcymiss 于 2014-10-22 12:36 编辑

新手作业：
网站：http://www.pinble.com/Lottery.htm
操作：点击“各省体彩”---“江苏七星彩”，获取江苏七星彩的数据。
说明：同样，代码只需在ResponseText获取到所需数据就行了。不需要整理。

这个数据网页的确认稍有点难度，要有耐心。嘿嘿。

f61393569 · 发表于 2014-10-21 15:22

本帖最后由 f61393569 于 2014-10-21 15:24 编辑

敢问楼主有听过火车头吗？我经常使用来抓去数据啊，文章音频视频软件系统图片招聘新闻企业信息。。。。。。。。等等等等需要登录的论坛网站都可以的

QQ图片20141021152428.jpg

wcymiss · 发表于 2014-10-21 15:25

本帖最后由 wcymiss 于 2014-10-22 16:52 编辑

获取数据-直接获取-静态参数：

在Request框内经常能看到各种参数。

参数用于客户端与服务器的交互。
参数的结构形式是：
参数名1=参数值1&参数名2=参数值2&参数名3=参数值3.....
参数存在于SendData中（即vba代码里Send方法后面的那部分，又称POSTData、SendBody等），也存在于URL中。

在15楼的例子，参数存在于SendData中：
type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A

14楼的作业，参数存在于URL里。

点击Request框的WebForms按钮可清楚的查看各参数：
上面的“QueryString”框内显示的是URL部分的参数明细；
下面“Body"框内显示的是SendData部分的参数明细。

通过多次对网站不同操作的抓包对比，可分析出每个参数各自对应的页面的选项。据此，在代码里定义多个变量，可动态获取各种不同的查询结果。

没有值的参数，大多时候可以省略。比如：
type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=%E7%A1%AE%E5%AE%9A
可以省略写成：
type=2&CompanyID=11%7C%E6%BE%B3%E9%97%A8&leagueID=36&teamID=0&kind=1&do0=%E7%A1%AE%E5%AE%9A

上述URL或SendData里的参数都是大部分都是静态的（14楼作业2里有一个参数非静态），也就是说，不管何时何地，只要服务器后台代码不改变，相同的页面选择，参数总也是相同的。

但很多网页都有动态参数。动态参数有防盗链的效果。即使你操作手法完全相同，动态参数也会有不同。这个在之后的知识点里会有具体讲解。

小贴士：查询的数据有多页时，这个页码会以参数的形式体现在发包头内。

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

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

获取数据-直接获取-转码：

在15楼的例子中：

从Request框的WebForms中可以看到：
CompanyID参数的值是“11|澳门”
do0参数的值是“确定”

但在Raw里看到的是：
CompanyID=11%7C%E6%BE%B3%E9%97%A8
do0=%E7%A1%AE%E5%AE%9A

这样的转换，可以用Javascript转换函数encodeURI或encodeURIComponent来实现（两者区别请自行百度）。

为了使代码容易解读，也为了让代码更换参数更加方便，我们将15楼的代码改动为：

Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "http://cn.zso8.com/odds/search/", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
' .setRequestHeader "Referer", ""
.Send "type=2&CompanyID=" & encodeURI("11|澳门") & "&leagueID=36&teamID=0&kind=1&port=&odds1=&do0=" & encodeURI("确定")
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

自定义函数encodeURI请从11楼里复制。

但字符编码的类型有很多。上述只是一种比较常见的类型。一般来说，当一个中文转成3个16进制的码时（“%XX”为一个16进制码），适合用javascript的encodeURI或encodeURIComponent函数来解码。（实质是utf-8编码）

有时候是这样的编码：“abc一二三”转换为“abc%D2%BB%B6%FE%C8%FD” (ET的登录，用户名就是这样的编码）
在vba里，hex(asc("一"))="D2BB"，所以，用循环及文本函数可以很容易写出转码的自定义函数：

Function GBKEnCode(strText)
Dim i, s
For i = 1 To Len(strText)
s = Hex(Asc(Mid(strText, i, 1)))
If Len(s) = 4 Then s = Left(s, 2) & "%" & Right(s, 2)
GBKEnCode = GBKEnCode & "%" & s
Next
End Function

复制代码

有人说，你这样连“abc”三个字符都转成“%61%62%63”了。。。没错，确实全部转了。但全部转了也可以Send成功的。不信你试试？

至于其他类型的编码，我想，只要你熟悉循环和文本函数，再了解下vba里的hex，asc，chr，ascw，chrw，总能写出自定义的转码函数的。

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

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

点评

评分

评分

评分

评分

评分

点评

评分

评分