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

wcymiss · 发表于 2014-11-16 22:05

VBA万岁发表于 2014-11-14 15:46
老师，我用你的代码（用户名及密码需改为自已的）运行后，登陆成功，接着进入依次进入“个人帐户”-“我的 ...

经过多次测试，发现也不是漏了两个参数的问题，是登录网站进行查询时，需要设置下发送头里的cookie。

代码如下：

Sub Main()
Const UserName As String = "vbatest" '假设的账户
Const UserPwd As String = "12341234"
Dim strText As String
Dim strJS As String
Dim strJSFun As String
Dim pwdRtn As String
Dim strCookie As String
Dim Temp, i As Integer
With CreateObject("WinHttp.WinHttpRequest.5.1")
'1、获取js文件的js代码：
.Open "GET", "http://img1.soufun.com/secondhouse/image/magent/js/RSA.js", False
.Send
strJS = .responsetext
.Open "GET", "http://img1.soufun.com/secondhouse/image/magent/js/BigInt.js", False
.Send
strJS = strJS & ";" & .responsetext
.Open "GET", "http://img1.soufun.com/secondhouse/image/magent/js/Barrett.js", False
.Send
strJS = strJS & ";" & .responsetext
'2、截取函数cmdEncrypt的执行语句，并把获取str_userpwd文本框的值的代码替换为我们的密码变量。
.Open "GET", "http://agent.fang.com/", False
.Send
strText = .responsetext
strJSFun = Mid(strText, InStr(strText, "setMaxDigits("))
strJSFun = Left(strJSFun, InStr(strJSFun, "$(""#str_userpwd"").attr(""value"", pwdRtn);") - 1)
strJSFun = Replace(strJSFun, "$(""#str_userpwd"").attr(""value"")", "'" & UserPwd & "'")
'3、将strJS和strJSFun结合后执行，取出pwdRtn值：
pwdRtn = JSEval(strJS & ";" & strJSFun & ";pwdRtn")
'4、登录
.Open "POST", "http://agent.soufun.com/DealCenterLogin.aspx?codev=" & Round(Rnd() * 10000), False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send "str_username=" & UserName & "&str_userpwd=" & pwdRtn & "&Submit1=%B5%C7++%C2%BC"
' Debug.Print .getallresponseheaders '有三个Set-Cookie表明登录成功
'5、获取Cookie
Temp = Split(.getallresponseheaders, "Set-Cookie: ")
Temp(0) = ""
For i = 1 To UBound(Temp)
Temp(i) = Split(Temp(i), ";")(0)
Next
strCookie = Mid(Join(Temp, ";"), 2)
If strCookie = "" Then MsgBox "登录失败！请检查账户密码是否正确": Exit Sub
'6、验证登录
.Open "GET", "http://n.agent.fang.com/Magent/Agent/agentinfo/ModifyAgent1.aspx", False
.setRequestHeader "Cookie", strCookie
.Send
Debug.Print .responsetext
End With
End Sub
Function JSEval(s As String) As String
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
JSEval = .Eval(s)
End With
End Function

复制代码

之前的帖子也不麻烦版主编辑了，反正之前的代码主要目的是加密参数的演示。基本不受影响。我再稍作点补充就是。

PS:获取header里的cookie必须要用winhttp。xmlhttp获取的不完全。（httponly的就获取不到，和IE还真是弟兄俩）

VBA万岁 · 发表于 2014-11-17 11:14

wcymiss 发表于 2014-11-16 22:05
经过多次测试，发现也不是漏了两个参数的问题，是登录网站进行查询时，需要设置下发送头里的cookie。

...

多谢老师！
不过我这里测试还是不成功：
首先，第46句是否应改为如下：
strCookie = Mid(Join(Temp, ";"), 2, Len(Join(Temp, ";")) - 1)
但，即使作如上更改后，测试仍不成功——虽登录成功但仍取不到数，如下截图：

wcymiss · 发表于 2014-11-17 14:55

本帖最后由 wcymiss 于 2014-11-17 14:58 编辑

VBA万岁发表于 2014-11-17 11:14
多谢老师！
不过我这里测试还是不成功：
首先，第46句是否应改为如下：

立即窗口显示的不全而已。你看前5000个字符就有信息了。Debug.Print Left(.responsetext, 5000)

如果获取信息不成功的话，立即窗口会返回“..............alert('请先登录！')..........”这样的字样

mid可以省略第三参数的。省略时默认为取到最后一个字符。这个帮助里有写的。

VBA万岁 · 发表于 2014-11-17 15:59

wcymiss 发表于 2014-11-17 14:55
立即窗口显示的不全而已。你看前5000个字符就有信息了。Debug.Print Left(.responsetext, 5000)

如果 ...

果真如此，多谢！！！

onthetrip · 发表于 2014-11-17 23:09

本帖最后由 onthetrip 于 2014-11-17 23:14 编辑

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

吴姐,我在公司内网上传文件发送邮件不能成功,麻烦您有空帮我看一下，谢谢先
手工操作步骤是这样的:
1/打开浏览器,输入网址,填入用户名,密码,附加码,登录
2/点击发送邮件
3/写入收件人名称
4/浏览附件
5/点击发送邮件
我在Fiddler中搜寻到了“2014年试考核”这个邮件附件所在的session，request框数据：

onthetrip · 发表于 2014-11-17 23:15

本帖最后由 onthetrip 于 2014-11-17 23:22 编辑

续上:
request数据:

POST http://222.68.172.80/data/email1/processsend.asp HTTP/1.1
Host: 222.68.172.80
Connection: keep-alive
Content-Length: 96064
Cache-Control: max-age=0
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8
Origin: http://222.68.172.80
User-Agent: Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/31.0.1650.63 Safari/537.36 SE 2.X MetaSr 1.0
Content-Type: multipart/form-data; boundary=----WebKitFormBoundarytz4ZP8xiB2NK10ch
Referer: http://222.68.172.80/data/email1/send.asp
Accept-Encoding: gzip,deflate,sdch
Accept-Language: zh-CN,zh;q=0.8
Cookie: ASPSESSIONIDAQCRDRBR=OAJJCAJAPDBCCNPFIANGNIEM
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="sjr"
小明,
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="topic"
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="gz"
无
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="text"
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="file1"; filename="2014年试考核.xls"
Content-Type: application/vnd.ms-excel
邢唷?? > ? ? ?

复制代码

onthetrip · 发表于 2014-11-17 23:17

晕倒,每个帖子字符数限制.续上

------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="file2"; filename=""
Content-Type: application/octet-stream
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="file3"; filename=""
Content-Type: application/octet-stream
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="file4"; filename=""
Content-Type: application/octet-stream
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="file5"; filename=""
Content-Type: application/octet-stream
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="B1"
发送邮件
------WebKitFormBoundarytz4ZP8xiB2NK10ch
Content-Disposition: form-data; name="c1"
否
------WebKitFormBoundarytz4ZP8xiB2NK10ch--

复制代码

onthetrip · 发表于 2014-11-17 23:19

续上,我按照您的代码稍作修改，修改后的代码

Sub Main()
Const SJR As String = "小明," '论坛UID
Const GZ As String = "无"
Dim Boundary As String
Dim SendData
Dim FileFullName As String
Dim FileShortName As String
Dim Title As String
Dim Filetype As String
FileFullName = "D:\2014年试考核.xls"
FileShortName = Mid(FileFullName, InStrRev(FileFullName, "") + 1)
Title = Left(FileShortName, InStrRev(FileShortName, ".") - 1)
Filetype = "xls"
'获取Boundary
Boundary = GetBoundary()
'获取上传所需的SendData
SendData = GetUpLoadSendData(Boundary, FileFullName, _
"sjr", SJR, _
"gz", GZ, _
"file1", FileShortName, _
"B1", "发送邮件", _
"c1", "否")
'上传
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "http://222.68.172.80/data/email1/processsend.asp", False
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
.setRequestHeader "Referer", "http://222.68.172.80/data/email1/send.asp"
.Send SendData
Debug.Print .responsetext '出现一串数字则为成功。到论坛发帖的界面可看到“未使用的附件”的提示。
End With
End Sub
Function GetBoundary() As String
'生成Boundary
Dim i As Integer, r As Integer
Do While i < 34
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(4, "-") & 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) - 6 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/vnd.ms-excel" & vbCrLf
DataBefore = DataBefore & vbCrLf
'文件流前面的字符串转为流
arrBytData(1) = StrToUTF8Byte(DataBefore)
'文件转流
arrBytData(2) = FileToByte(FileFullName)
'文件流之后的字符串（两项）
For i = UBound(NameValue) - 3 To UBound(NameValue) Step 2
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 ' & "--"
Next i
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 = "GB2312"
.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

复制代码

onthetrip · 发表于 2014-11-17 23:21

本帖最后由 onthetrip 于 2014-11-17 23:26 编辑

我查看了收件箱，没有发送成功debug.print 的数据:

<html>
<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 6.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>New Page 1</title>
</head>
<body>
<p>′?ê?</p>
<p>??</p>
3?ê±′í?ó!????D?μ???óê??!

复制代码

手工发送邮件成功的话,会有一个New Page 1的新窗口,提示邮件发送成功
另外：我是在点击“发送邮件”后在发邮件界面运行的代码;每次登录的Cookie都是一样的,无论清除缓存与否,设置Cookie头也没用

renahu · 发表于 2014-11-18 10:47

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

吴老师：
58同城这个例子中，共有4个JS文件，其中两个js文件地址是通过搜索函数名getm32str，getm16str，encryptString直接在request窗口中找到。另外两个JS文件的地址（下面）是如何找到的呢？
1.https://passport.58.com/static/p ... passport_version.js
2.https://passport.58.com/static/js/5_1/jquery1.3.2.js

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

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

评分