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

wcymiss · 发表于 2014-10-26 09:42

本帖最后由 wcymiss 于 2014-10-27 12:58 编辑

处理xml数据
8楼的例子返回的就是一个xml文档。

在excel里，有一个很快捷的方式导入xml文档：

Sub Main()
ThisWorkbook.XmlImport _
URL:="http://www.cffex.com.cn/fzjy/tjsj/pztj/pzrtj/2014/index.xml", _
ImportMap:=Nothing, _
Overwrite:=True, _
Destination:=ActiveSheet.Range("a1")
End Sub

复制代码

如果需要自定义提取的内容，你或者可以这样写：

Sub Main()
Dim arrEM(1 To 4), arrEMname
Dim arrData(1000, 1 To 4)
Dim i As Long, j As Long
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://www.cffex.com.cn/fzjy/tjsj/pztj/pzrtj/2014/index.xml", False
.send
arrEMname = Array(, "productid", "tradingday", "volume", "openinterest")
With .responseXML
For i = 1 To 4
Set arrEM(i) = .getElementsByTagName(arrEMname(i))
Next
For i = 0 To arrEM(1).Length - 1
For j = 1 To 4
arrData(i, j) = arrEM(j)(i).Text
Next
Next
End With
End With
Cells.Clear
Range("a1:d1").Value = Array("品种", "日期", "总成交量", "总持仓量")
Range("a2").Resize(i, 4).Value = arrData
End Sub

复制代码

xml的dom提取数据的方法有很多。
具体可以参考http://www.w3school.com.cn/xmldom/index.asp

小贴士：
1、当URL是一个格式化的xml文档时，xmlhttp可将服务器返回的数据整理为一个DomDocument对象放在responseXML中。
你也可以CreateObject("MSXML2.DomDocument")然后用load(url)或者loadxml(text)方法获得DomDocument对象。
2、点击Fiddler的Response框的XML按钮，可以很清晰的看到XML数据结构。

wcymiss · 发表于 2014-10-27 11:35

本帖最后由 wcymiss 于 2014-10-28 09:29 编辑

初识JSON

JSON数据的特点：
1、用方括号扩住的是数组，数组内元素以逗号分隔。如：["甲","乙","丙"]、[1,2,3]
2、用花括号扩住的是对象，对象内各属性以逗号分隔，属性名和属性值以冒号分隔。同一对象里的属性名不会重复。如对象{"name":"甲","age":36}，含name、age两个属性，属性值分别为 “甲”和36。
3、对象的属性值可以是数组。数组的元素可以是对象。JSON数据就是数组对象嵌套的大集合。比如，下面的JSON数据记录了甲乙二人的基本信息：

[{"name":"甲","age":36,"children":[{"name":"甲儿","age":10},{"name":"甲女","age":7}]},{"name":"乙","age":28,"children":[{"name":"乙女","age":6}]}]

复制代码

将其格式化后，看起来更清晰:

[
{
"name" : "甲",
"age" : 36,
"children" :
[
{
"name" : "甲儿",
"age" : 10
},
{
"name" : "甲女",
"age" : 7
}
]
},
{
"name" : "乙",
"age" : 28,
"children" :
[
{
"name" : "乙女",
"age" : 6
}
]
}
]

复制代码

解读：甲36岁，有10岁的甲儿和7岁的甲女两个子女；乙28岁，有6岁的乙女一个子女。

JSON数据易于解读，字符简短，方便网络传输，在网络中应用相当广泛。

敬请进入http://www.w3school.com.cn/json/index.asp学习更多JSON知识。

小贴士：
点击Fiddler的Response框的JSON按钮，可以很清晰的看到JSON数据结构。

再补个附件，对比下类似效果的table和xml：

对比类似效果的table和xml.rar (457 Bytes, 下载次数: 427)
可以都用excel打开，xml打开的时候选择“xml列表”

吐槽：囧！这篇帖子提交时居然提示我含有不良信息！后来一个个词检查，发现问题竟然在“孩子”二字上，改成“子女”就没问题了！！！。额滴大神，“孩子”二字有啥问题涅？

wcymiss · 发表于 2014-10-27 14:05

本帖最后由 wcymiss 于 2014-10-31 09:41 编辑

JSON转换成vba对象

1、JSON数组在vba内需要用For Each来获取其元素：（For Each 后面的变量不能定义为Object类型）

Sub Test()
Const strJSON As String = "[""甲"",""乙"",""丙""]"
Dim objJSON As Object
Dim Cell '这里不能定义为object类型
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.AddCode "var mydata =" & strJSON
Set objJSON = .CodeObject
End With
Stop '查看vba本地窗口里objJSON对象以了解JSON数据在vba里的形态
For Each Cell In objJSON.mydata
Debug.Print Cell
Next
End Sub

复制代码

2、JSON对象在vba内可直接用“对象.属性”的方法获取，但当名称不被vba允许时，用CallByName函数获取：

Sub Test()
Const strJSON As String = "{""name"":""甲"",""age"":36}"
Dim objJSON As Object
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.AddCode "var mydata=" & strJSON
Set objJSON = .CodeObject
End With
Stop '查看本地窗口
Debug.Print objJSON.mydata.age
Debug.Print objJSON.mydata.Name '此句出错
End Sub

复制代码

“name”作为vba对象的属性时会被自动首字母大写。而JavaScript里是区分大小写的，“Name”不能等同“name”，json数据里无“Name”属性，所以代码运行出错。

这时让我们请出“CallByName”吧。（使用前请先查看vba帮助中对此函数的说明）

将出错的那句代码改成：

Debug.Print CallByName(objJSON.mydata, "name", VbGet)

复制代码

ok。数据成功获取！

3、综合处理：

Sub Test()
Const strJSON As String = "[{""name"":""甲"",""age"":36,""children"":[{""name"":""甲儿"",""age"":10},{""name"":""甲女"",""age"":7}]},{""name"":""乙"",""age"":28,""children"":[{""name"":""乙女"",""age"":6}]}]"
Dim objJSON As Object
Dim Person, Child
Dim arrData(1 To 100, 1 To 4)
Dim i As Long
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
.AddCode "var mydata =" & strJSON
Set objJSON = .CodeObject
End With
Stop '多多查看本地窗口，你才会进步更快。。。
'为了编写方便，假设每个Person的children数组里至少有一个元素：
For Each Person In CallByName(objJSON, "mydata", VbGet)
For Each Child In CallByName(Person, "children", VbGet)
i = i + 1
arrData(i, 1) = CallByName(Person, "name", VbGet)
arrData(i, 2) = CallByName(Person, "age", VbGet)
arrData(i, 3) = CallByName(Child, "name", VbGet)
arrData(i, 4) = CallByName(Child, "age", VbGet)
Next
Next
Cells.Clear
Range("a1:d1").Value = Array("name", "age", "childname", "childage")
Range("a2").Resize(i, 4).Value = arrData
End Sub

复制代码

个人建议：为了区分vba对象本身的属性，建议JSON对象的属性都用CallByName表示。

更多在vba中使用JavaScript的例子，敬请参考figfig大师的帖子：
http://club.excelhome.net/thread-478544-1-1.html、
http://club.excelhome.net/thread-483942-1-1.html、
http://club.excelhome.net/thread-484702-1-1.html

wcymiss · 发表于 2014-10-27 15:49

本帖最后由 wcymiss 于 2014-10-27 16:51 编辑

编写JavaScript代码处理JSON（一）

个人为了练习分析JavaScript、JSON的能力，常编写JavaScript处理JSON成一个“表格文本”，放入剪贴板后粘贴到工作表内。

此法需要学习JavaScript知识。http://www.w3school.com.cn/js/index.asp

仍以之前的JSON数据为例：

Sub Test()
Const strJSON As String = "[{""name"":""甲"",""age"":36,""children"":[{""name"":""甲儿"",""age"":10},{""name"":""甲女"",""age"":7}]},{""name"":""乙"",""age"":28,""children"":[{""name"":""乙女"",""age"":6}]}]"
Dim strJS As String
Dim strTable As String
'为了编写方便，假设每个Person的children数组里至少有一个元素：
strJS = "var mydata=" & strJSON _
& ";var i,j;var s='name\tage\tchildname\tchildage\r';" _
& "for(i=0;i<mydata.length;i++){for(j=0;j<mydata[i].children.length;j++)" _
& "{s+=mydata[i].name+'\t'+mydata[i].age+'\t'+mydata[i].children[j].name+'\t'+mydata[i].children[j].age+'\r'}};"
strTable = JSEval(strJS)
Debug.Print strTable
CopyToClipbox strTable
Cells.Clear
Range("a1").Select
ActiveSheet.Paste
End Sub
Function JSEval(strJS As String) As String
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
JSEval = .Eval(strJS)
End With
End Function
Sub CopyToClipbox(strText As String)
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
End Sub

复制代码

JavaScript的'\t'相当于 vbTab，'\r'相当于 vbCr，取出值后，每列之间用'\t'连接，每行之间用'\r'连接，这样的文本复制到剪贴板后，可直接粘贴到工作表形成表格数据。

本法非主流，不喜勿用！

wcymiss · 发表于 2014-10-27 16:45

本帖最后由 wcymiss 于 2014-10-28 09:53 编辑

编写JavaScript代码处理JSON（二）

以70楼的获取QQ群成员列表的数据为例，再上一个处理JSON的例子：

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 strJS As String
Dim strTable As String
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
End With
strJS = "var mydata=" & strText _
& ";var x,qq,s='qq号\t昵称\t群名片\t等级\r';" _
& "var mems=mydata.mems,cards=mydata.cards,lv=mydata.lv,lvname=mydata.levelname;" _
& "for(x in mems){qq=mems[x].u;s+=qq+'\t'+mems[x].n+'\t'+(cards[qq]||'')+'\t'+lvname['lvln'+lv[qq].l]+'\r'}"
strTable = JSEval(strJS)
CopyToClipbox strTable
Cells.Clear
Range("a1").Select
ActiveSheet.Paste
End Sub

复制代码

此JSON数据内的很多对象都以QQ号为属性名，如mems[qq]可得该成员基本信息，cards[qq]得到群名片信息。所以可以遍历mems对象后获取qq号和昵称，再获取该qq群名片信息和等级信息组成table表。

如果不用JavaScript语句处理此JSON，因为群名片和群员等级在不同的对象里，取出后需要按照QQ号用字典来定位匹配。这样代码就相对较长了。有兴趣的朋友可以写个练练手。

wcymiss · 发表于 2014-10-27 16:58

本帖最后由 wcymiss 于 2014-10-28 09:16 编辑

作业四

除了我上面的用javascript代码处理的方式，用其他方式提取群成员列表。包括：qq号、昵称、群名片、等级。

wcymiss · 发表于 2014-10-28 09:59

占楼

wcymiss · 发表于 2014-10-28 11:50

本帖最后由 wcymiss 于 2014-10-28 16:59 编辑

初识登录

登录其实没那么神秘。它也就是向服务器发送的一个POST请求。

我们来看一个简单的登录例子，以网易信箱（163.com）为例。

打开Fiddler，打开浏览器，登录网易信箱同时抓包。
搜索登录名vbatest（今天新注册的，你们可以随便整。哈哈）：

登录0.png

前面有

标记的表明是POST请求。

163登录2.png

选择该session，点击Request框的Raw按钮通览一下所有发送内容：

163登录3.png

password竟然是明码，小小鄙视下网易。

再看Response框。哇，满满的Set-Cookie啊。最关键的里面有一句“LOGIN_SUCCESS”！！

163登录5.png

这样可以确定这个session是我们要找的登录session了！我们只要把它的Request的内容模拟好了就能成功登录（好期待）。

点击Request框的WebForms按钮通览发送的各参数：

163登录4.png

居然没有动态参数。。（乐坏了）

cookie、referer的先不忙测试。先copy抓包内容，写代码：

Sub Main()
Const username As String = "vbatest"
Const password As String = "12341234"
Dim strText As String
Dim uid As String
uid = username & "@163.com"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://mail.163.com/entry/cgi/ntesdoor?df=mail163_letter&funcid=loginone&iframe=1&passtype=1&product=mail163&race=63_31_31_gz&uid=" & username & "@163.com", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send "savelogin=0&url2=http%3A%2F%2Fmail.163.com%2Ferrorpage%2Ferror163.htm&username=" & username & "&password=" & password & "&password="
strText = .getallresponseheaders
Debug.Print strText
strText = .responsetext
Debug.Print strText
End With
End Sub

复制代码

立即窗口：

登录成功！

小贴士：
1、不要以密码作为搜索内容。密码经常被加密。以密码原文作为搜索内容很可能搜不到所需session。
2、以登录名作为搜索内容相对好些。但也有可能被加密而搜不到正确的session。这时搜到的包含登录名的最早的session可能是登录后出现的页面。登录的session前面一般都有post的图标，可以根据这个再加上查看Request和Response的内容判断是否是我们所需的登录session。

===============
经过kangatang提醒，本例经过测试，将SendData的参数作为URL的参数用GET请求也可以实现登录，代码如下（原SendData的参数我精简了，只留了用户名和密码）：

Sub Main()
Const username As String = "vbatest"
Const password As String = "12341234"
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1") '
.Open "GET", "https://mail.163.com/entry/cgi/ntesdoor?df=mail163_letter&funcid=loginone&iframe=1&passtype=1&product=mail163&race=63_31_31_gz&uid=" & username & "@163.com&" & "username=" & username & "&password=" & password, False
.send
Debug.Print .Getallresponseheaders
Debug.Print .responsetext
End With
End Sub

复制代码

但不是所有的网站都可以这样的。这只是个例。

wcymiss · 发表于 2014-10-28 16:46

本帖最后由 wcymiss 于 2014-10-29 14:25 编辑

登录之后可以做什么----查询数据

登录并非是我们的最终目的。最终目的是查询一些非登录不能查看的数据，或是发送数据。如论坛登录后，可下载附件，可发帖；邮箱登录后，可收件发件。

前面讲过，xmlhttp和winhttp只要该对象不销毁，都可以保持cookie。我们登录就是为了取得一个被允许查看数据和发送数据的cookie，然后执行查询和发送的请求。

仍以网易邮箱为例：

登录后网页显示邮件列表，此过程抓包。

163登录1.png

抓包后，在fiddler内搜索邮件列表页面内的某字符串，查找到显示邮件列表的页面：（Response返回一串JSON数据）

邮件2.png

拷贝Request的相关内容，编写代码：

Sub Main()
Const username As String = "vbatest"
Const password As String = "12341234"
Dim strText As String
Dim sid As String
With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1") '
.Open "POST", "https://mail.163.com/entry/cgi/ntesdoor?df=mail163_letter&funcid=loginone&iframe=1&passtype=1&product=mail163&race=63_31_31_gz&uid=" & username & "@163.com", False
.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
.send "username=" & username & "&password=" & password
sid = Split(Split(.responsetext, "sid=")(1), "&")(0)
.Open "POST", "http://mail.163.com/js6/s?sid=" & sid & "&func=mbox:listMessages&topNav_mobileIcon_show=1&TopTabReaderShow=1&TopTabReaderTipsShow=1&FrameMasterMailPopupClose=1&welcome_welcomemodule_mailrecom_click=1&LeftNavfolder1Click=1&mbox_folder_enter=1", False
.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
.setrequestheader "Accept", "text/javascript" '不加这句的话返回的不是json是xml数据
.send "var=" & encodeURI("<?xml version=""1.0""?>" _
& "<object>" _
& "<int name=""fid"">1</int>" _
& "<string name=""order"">date</string>" _
& "<boolean name=""desc"">true</boolean>" _
& "<int name=""limit"">20</int>" _
& "<int name=""start"">0</int>" _
& "<boolean name=""skipLockedFolders"">false</boolean>" _
& "<string name=""topFlag"">top</string>" _
& "<boolean name=""returnTag"">true</boolean>" _
& "<boolean name=""returnTotal"">true</boolean>" _
& "</object>") Debug.Print .responsetext
End With
End Sub

复制代码

查看邮件列表的SendData是一个xml数据。不管它什么数据，我们都照样copy就是了。

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

本帖最后由 wcymiss 于 2014-10-29 14:25 编辑

登录之后可以做什么----发送数据

上一贴说的是登录后查看邮件。这次来试一次发送邮件。

手工登录、发送邮件，同时抓包。

截取发送邮件内容的部分字符串作为搜索文本，找到session。

拷贝Request里相关内容，编写代码：

Sub Main()
Const Username As String = "vbatest"
Const Password As String = "12341234"
Const Account As String = "vbatest@163.com"
Const ToAccount As String = "wcymiss@163.com"
Const Subject As String = "主题：用web发送邮件"
Const Content As String = "正文：看到此邮件则证明发送成功"
Dim strText As String
Dim Sid As String
Dim Senddata
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://mail.163.com/entry/cgi/ntesdoor?df=mail163_letter&funcid=loginone&iframe=1&passtype=1&product=mail163&race=63_31_31_gz&uid=" & Username & "@163.com", False
.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
.Send "username=" & Username & "&password=" & Password
Sid = Split(Split(.responsetext, "sid=")(1), "&")(0)
.Open "POST", "http://mail.163.com/js6/s?sid=" & Sid & "&func=mbox:compose&FrameMasterMailPopupClose=1&cl_send=2&l=compose&action=deliver", False
.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
.setrequestheader "Accept", "text/javascript" '不加这句的话返回的不是json是xml数据
Senddata = "var=" & encodeURI("<?xml version=""1.0""?>" _
& "<object>" _
& "<string name=""id"">c:" & GetLongTime() & "</string>" _
& "<object name=""attrs"">" _
& "<string name=""account"">" & Account & "</string>" _
& "<boolean name=""showOneRcpt"">false</boolean>" _
& "<array name=""to""><string>" & ToAccount & "</string></array>" _
& "<array name=""cc""/><array name=""bcc""/>" _
& "<string name=""subject"">" & Subject & "</string>" _
& "<boolean name=""isHtml"">true</boolean>" _
& "<string name=""content"">" & Content & "</string>" _
& "<int name=""priority"">3</int>" _
& "<boolean name=""saveSentCopy"">true</boolean>" _
& "<string name=""charset"">GBK</string></object>" _
& "<boolean name=""returnInfo"">false</boolean>" _
& "<string name=""action"">deliver</string>" _
& "<int name=""saveTextThreshold"">1048576</int>" _
& "</object>")
.Send Senddata
Debug.Print .responsetext
End With
End Sub
Function encodeURI(strTobecoded As String) As String
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
encodeURI = .eval("encodeURIComponent('" & strTobecoded & "');")
End With
End Function
Function GetLongTime()
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
GetLongTime = .eval("new Date().getTime();")
End With
End Function

复制代码

SendData里有部分参数还可以精简。有兴趣的话可以自己测试。

GetLongTime自定义函数的作用是产生一个国际通用的表示当前时间的13位数字。

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

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

评分

评分

评分

评分

评分

点评

最新热点 /1