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

renahu · 发表于 2014-11-1 16:16

coby001 发表于 2014-11-1 15:17
回复框上端，笑脸表情的左边，有对尖括号：

谢谢老师指点

liucqa · 发表于 2014-11-1 16:44

renahu 发表于 2014-11-1 14:35
吴老师，能不能这样认为：一个汉字如果用三个十六进制的数表示就是utf8码，一个汉字如果用两个十六进制的 ...

http://club.excelhome.net/thread-998747-1-1.html

wcymiss · 发表于 2014-11-1 17:13

本帖最后由 moon2778 于 2014-11-26 10:17 编辑

上传文件
同样，上传文件也可以用fiddler抓包。

以EH的论坛上传附件为例。我们上传一个很小的压缩文件来测试（太大了的话，Fiddler的Raw里看不完整）。

在fiddler里搜索文件名（不含路径），确认我们需要模拟的网页。

上传1.png

webforms更清晰：

上传2.png

我们看到上传文件的POST的特点：
1、Content-Type是multipart/form-data，而且后面有一个boundary的赋值（10个英文减号+30个随机字母数字混合字符串），普通的POST的Content-Type是application/x-www-form-urlencoded了。
2、SendData的内容，各项内容以Content-Type里的boundary值分隔，但前面还加了两个英文减号，最后的boundary在末尾处也加了两个英文减号。
3、每项内容除文件流外是“Content-Disposition: form-data; name="名称"”+空行+值组成。
4、文件转成了二进制流，作为SendData其中一项内容，Content比其余各项略微复杂些。

我们也只需要按照这样的格式进行POST发送。

但要注意：字符串与字符串可以用“&”连接，但字符串与二进制流不能将流转为文本后用“&”连接，而应将字符串转为二进制流后再进行连接（数组方式、adostream均可连接流数据）。二进制流转为文本后会被系统按照默认编码格式进行编码，这样容易导致上传文件的格式不正确。

EH上传附件的代码（手工填入hash码即可上传了）：

Sub Main()
Const Uid As String = "" '论坛UID
Const Hash As String = "" '上传的Hash，从Fiddler里取
Dim Boundary As String
Dim SendData
Dim FileFullName As String
Dim FileShortName As String
Dim Title As String
Dim Filetype As String
FileFullName = "D:\测试2.rar"
FileShortName = Mid(FileFullName, InStrRev(FileFullName, "") + 1)
Title = Left(FileShortName, InStrRev(FileShortName, ".") - 1)
Filetype = "rar"
'获取Boundary
Boundary = GetBoundary()
'获取上传所需的SendData
SendData = GetUpLoadSendData(Boundary, FileFullName, _
"Filename", FileShortName, _
"proid", "0", _
"hash", Hash, _
"uid", Uid, _
"title", Title, _
"filetype", Filetype, _
"Filedata", FileShortName, _
"Upload", "Submit Query")
'上传
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://club.excelhome.net/misc.php?mod=swfupload&fid=2&action=swfupload&operation=upload", False
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
.Send SendData
Debug.Print .responsetext '出现一串数字则为成功。到论坛发帖的界面可看到“未使用的附件”的提示。
End With
End Sub
Function GetBoundary() As String
'生成Boundary
Dim i As Integer, r As Integer
Do While i < 30
r = Int(Rnd * 75 + 48)
If r < 58 Or (r > 64 And r < 91) Or r > 96 Then
GetBoundary = GetBoundary & Chr(r)
i = i + 1
End If
Loop
GetBoundary = String(10, "-") & GetBoundary
End Function
Function GetUpLoadSendData(Boundary As String, FileFullName As String, ParamArray NameValue()) As Byte()
'NameValue()必须成双，前一个是名称，后一个是值
'NameValue()最后一对是文件流之后的名称值对
'NameValue()倒数第二对是文件流信息相关的两个数据
Dim DataBefore, DataAfter
Dim arrBytData(1 To 3), bytData() As Byte
Dim i As Long, j As Long, n As Long
'连接文件流之前的各项名称值对
For i = 0 To UBound(NameValue) - 4 Step 2 '最后两对单独处理
DataBefore = DataBefore & "--" & Boundary & vbCrLf
DataBefore = DataBefore & "Content-Disposition: form-data; name=""" & NameValue(i) & """" & vbCrLf
DataBefore = DataBefore & vbCrLf
DataBefore = DataBefore & NameValue(i + 1) & vbCrLf
Next
'连接文件流此项的Content-Disposition
DataBefore = DataBefore & "--" & Boundary & vbCrLf
DataBefore = DataBefore & "Content-Disposition: form-data; name=""" & NameValue(i) & """; filename=""" & NameValue(i + 1) & """" & vbCrLf
DataBefore = DataBefore & "Content-Type: application/octet-stream" & vbCrLf
DataBefore = DataBefore & vbCrLf
'文件流前面的字符串转为流
arrBytData(1) = StrToUTF8Byte(DataBefore)
'文件转流
arrBytData(2) = FileToByte(FileFullName)
'文件流之后的字符串（一项）
DataAfter = "--" & Boundary & vbCrLf
DataAfter = DataAfter & "Content-Disposition: form-data; name=""" & NameValue(i) & """" & vbCrLf
DataAfter = DataAfter & vbCrLf
DataAfter = DataAfter & NameValue(i + 1) & vbCrLf
DataAfter = DataAfter & "--" & Boundary & "--"
arrBytData(3) = StrToUTF8Byte(DataAfter) '转为流
'合并字符流和文件流
ReDim bytData(UBound(arrBytData(1)) + UBound(arrBytData(2)) + UBound(arrBytData(3)) + 2)
For i = 1 To 3
For j = 0 To UBound(arrBytData(i))
bytData(n) = arrBytData(i)(j)
n = n + 1
Next
Next
GetUpLoadSendData = bytData
End Function
Function StrToUTF8Byte(strText)
'文本转UTF-8编码并去除BOM头
With CreateObject("adodb.stream")
.Mode = 3 'adModeReadWrite
.Type = 2 'adTypeText
.Charset = "UTF-8"
.Open
.Writetext strText
.Position = 0
.Type = 1 'adTypeBinary
.Position = 3 '去除UTF-8编码文本前面的BOM头（三个字节）
StrToUTF8Byte = .Read()
.Close
End With
End Function
Function FileToByte(strFileName As String)
'文件转流
With CreateObject("Adodb.Stream")
.Open
.Type = 1 'adTypeBinary
.LoadFromFile strFileName
FileToByte = .Read
.Close
End With
End Function

复制代码

yeah ,大功告成

分享下VBS大神Demon的上传文件的代码：

http://demon.tw/programming/vbs-post-file.html

小贴士：
文件流前后的文本如果不用UTF-8编码的话，文件可以上传成功，但文件名里的中文可能无法正确显示。

onlycxb · 发表于 2014-11-1 18:13

为防止误导，360楼代码已经删减。

coby001 · 发表于 2014-11-1 18:29

onlycxb 发表于 2014-11-1 18:13
为防止误导，360楼代码已经删减。

不用删啊，改个名字就好了，转义函数还是有用的~

renahu · 发表于 2014-11-1 19:06

wcymiss 发表于 2014-10-21 12:51
更多Fiddler的使用方法，敬请参考《Fiddler调试权威指南》一书。
电子书下载地址：http://pan.baidu.com/s ...

吴老师，非常感谢您的课程，让我掌握了一些网抓基础知识，虽然还不能想抓什么抓什么，但也能抓点儿想要的了，我也开了个帖子，把平时练习抓的东西放上去，欢迎您光临指导，再次表示衷心感谢。
http://club.excelhome.net/thread-1162676-1-1.html

xmyjk · 发表于 2014-11-2 18:22

本帖最后由 xmyjk 于 2014-11-2 19:00 编辑

wcymiss 发表于 2014-11-1 17:13
上传文件
同样，上传文件也可以用fiddler抓包。

好东西，这让我想起了，当时想借good.gd做一个自动上传程序更新，然后分发的工具。
可惜后来烂尾了。不过文件上传模块倒是写好了，没想到现在还能用。
借花献佛了。

原理基本如吴姐所说。
xmlhttp等控件，如果要发送数据流，就不能使用文本格式的报文主体，但是VB中又不能直接把byte的字节形式的数组送给.send方法来发。
解决方法就是，用一个变体的变量来过度。

程序流程类似，就是我是把文件用open binary函数读入，前后字符串用strconv函数转成ansi的byte数组，然后再用copymemery连接数组。
后话：
在vb中如果发送字节数据，xmlhttp不会转码，就这么出去，如果发送的是文本，不符合规范的文本会自动转为按utf8进行编码再出去。所以gbk那些都要手工转码。
献丑了，当年的代码附件如下：

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Sub upload()
Dim xmlhttp, sess As String, uid As String, b As String, i As Long, n As Long
Dim fl() As Byte, senddata, flnm As String, aft() As Byte, bef() As Byte, tmp As String, arr() As Byte
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
flnm = Format(Date, "yymmdd") & " " & Format(Time, "hh时mm分") & "bak.xls"
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "" & flnm
With xmlhttp
.Open "GET", "http://upload.good.gd/upload.aspx", False
.send
sess = Split(Split(.responsetext, "var SESSIONID = '")(1), "'")(0)
uid = Split(Split(.responsetext, "var UploadID = '")(1), "'")(0)
b = getboundary
Open ThisWorkbook.Path & "" & flnm For Binary As #1
ReDim fl(LOF(1) - 1) As Byte
Get #1, , fl()
Close #1
tmp = "Content-Disposition: form-data; name=""Filename""" & vbCrLf & vbCrLf & _
flnm & vbCrLf & _
"------------" & b & vbCrLf & _
"Content-Disposition: form-data; name=""ASPSESSID""" & vbCrLf & vbCrLf & _
sess & vbCrLf & _
"------------" & b & vbCrLf & _
"Content-Disposition: form-data; name=""Filedata""; filename=""" & flnm & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf
bef = StrConv(tmp, vbFromUnicode)
tmp = ""
tmp = vbCrLf & "------------" & b & vbCrLf & _
"Content-Disposition: form-data; name=""Upload""" & vbCrLf & vbCrLf & _
"Submit Query" & vbCrLf & _
"------------" & b & "--"
aft = StrConv(tmp, vbFromUnicode)
ReDim arr(UBound(bef) + 1 + UBound(aft) + 1 + UBound(fl)) As Byte
CopyMemory arr(0), bef(0), UBound(bef) + 1
CopyMemory arr(UBound(bef) + 1), fl(0), UBound(fl) + 1
CopyMemory arr(UBound(bef) + 1 + UBound(fl) + 1), aft(0), UBound(aft) + 1
senddata = arr
.Open "POST", "http://upload.good.gd/Receive/ReceiveData.aspx?c=uploadgood&flash=true&uid=" & uid, False
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & "----------" & b
.send senddata
[b2] = "http://good.gd/" & Split(.responsetext, "|")(1) & ".htm"
End With
Kill ThisWorkbook.Path & "" & flnm
End Sub
Function getboundary() As String
Dim i&
For i = 1 To 10
getboundary = getboundary & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 97)
getboundary = getboundary & Chr(Int(Rnd * 10) + 48)
Next
End Function

复制代码

good网页备份文件.zip (16.35 KB, 下载次数: 103)

etsure · 发表于 2014-11-2 20:09

etsure 发表于 2014-11-1 00:53

liangdonghao222 · 发表于 2014-11-3 10:46

wcymiss 发表于 2014-11-1 17:13
上传文件
同样，上传文件也可以用fiddler抓包。

吴姐，再次咨询一个问题，假如我用xmlhttp法用createobject("htmlfile") 可以像ie法那样查找标签值进行click 或者 select 那样的操作吗？不然有的是要查找标签值才可以选择不知道怎么写

hecli · 发表于 2014-11-3 10:59

wcymiss 发表于 2014-10-29 16:27
复杂登录二：58同城登录

吴老师能弄个58同城抓取简历联系方式的程序不？

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

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

评分

点评

评分

评分

点评

点评

最新热点 /1