|
|
本帖最后由 飞龙 于 2013-1-1 14:22 编辑
废话不多说，首先我们要用到的工具HttpWatch（功能强大的网页截包工具） vb6.0企业版（200M左右)
好像要用ie浏览器才能使用httpwatch这个软件 如果你想截取其他的什么封包 在这里推荐WireShark（PS。wap登录由于用ie好像不行，我在这里用的就是WireShark截取的，如何使用请看网上的教程）
我们安装好httpwatch
这里我用http登录作为讲解
打开IE -查看 -浏览器栏-把httpwatch勾上
我们就会看到如下的界面
然后我们到要截包的页面 也就是登录页面
我们用 郎合:EBTOLS 这个马甲来测试
先把账号和密码输入进去 然后点httpwatch的record按钮
然后点击登录
一般我们就用到这2样数据
好，我们来做一个使用http刷粉的源码（新版个人贴吧的刷粉）
代码篇
打开vb6.0
新建工程
这里我就以简单通俗的方式给大家讲解一下 代码会有点繁琐
声明 本文大部分源码来自网络，经本人收集整理，在此对前辈们表示感谢
首先我们要准备的代码 下面的源码不用研究，直接复制粘贴就行了
首先声明全局变量
dim mycookie as string '用来存放cookies
dim login as long '这个用来判断是带不带cookies访问
dim token as string '存放数据
dim portrait as string '同上
Private Function GetCookie(str$) '不多做解释 ，这就是一个获取cookie的代码
Dim cookie$
Dim a, b, c, d, e, f
a = InStr(str, "Set-Cookie: ")
If a = 0 Then
GetCookie = ""
Else
b = InStr(a, str, ";"): c = Mid(str, a + 12, b - a - 11)
cookie = c
Do
d = InStr(b, str, "Set-Cookie: ")
If d = 0 Then Exit Do
e = InStr(d, str, ";"): f = Mid(str, d + 12, e - d - 11)
b = e
cookie = cookie & f
Loop
GetCookie = cookie
End If
End Function
Private Function UTF8EncodeURI(ByVal szInput As String) As String '汉字转换成utf8编码的代码
Dim wch As String
Dim uch As String
Dim szRet As String
Dim x As Long
Dim inputLen As Long
Dim nAsc As Long
Dim nAsc2 As Long
Dim nAsc3 As Long
If szInput = "" Then
Dim UTF8Encode
UTF8Encode = szInput
Exit Function
End If
inputLen = Len(szInput)
For x = 1 To inputLen
'得到每个字符
wch = Mid(szInput, x, 1)
'得到相应的UNICODE编码
nAsc = AscW(wch)
'对于<0的编码 其需要加上65536
If nAsc < 0 Then nAsc = nAsc + 65536
'对于<128位的ASCII的编码则无需更改
If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
'真正的第二层编码范围为000080 - 0007FF
'Unicode在范围D800-DFFF中不存在任何字符，基本多文种平面中约定了这个范围用于UTF-16扩展标识辅助平面（两个UTF-16表示一个辅助平面字符）.
'当然，任何编码都是可以被转换到这个范围，但在unicode中他们并不代表任何合法的值。
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
'第三层编码00000800 – 0000FFFF
'首先取其前四位与11100000进行或去处得到UTF-8编码的前8位
'其次取其前10位与111111进行并运算，这样就能得到其前10中最后6位的真正的编码 再与10000000进行或运算来得到UTF-8编码中间的8位
'最后将其与111111进行并运算，这样就能得到其最后6位的真正的编码 再与10000000进行或运算来得到UTF-8编码最后8位编码
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next
UTF8EncodeURI = szRet
End Function
Function GBKEncodeURI(szInput) '汉字转gbk编码源码，供其他过程调用
Dim i2 As Long
Dim x() As Byte
Dim szRet As String
szRet = ""
x = StrConv(szInput, vbFromUnicode)
For i2 = LBound(x) To UBound(x)
szRet = szRet & "%" & Hex(x(i2))
Next
GBKEncodeURI = szRet
End Function
下面的代码比较重要，你可以酌情更改，========================================
Private Function XMLHttpRequest(ByVal XmlHttpMode, ByVal XmlHttpURL, ByVal XmlHttpData)
On Error GoTo wrong
Set MyXmlhttp = CreateObject("Msxml2.ServerXMLHTTP.6.0")
With MyXmlhttp
.setTimeouts 3000, 3000, 3000, 3000
If XmlHttpMode = "POST" Then
.Open "POST", XmlHttpURL, True
Else
.Open "GET", XmlHttpURL, True
End If
If XmlHttpMode = "POST" Then
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
End If
If Login = 2 Then
.setRequestHeader "Cookie", MyCookie
End If
.send XmlHttpData
.waitForResponse
If MyXmlhttp.Status = 200 Then
XMLHttpRequest = .responseText
If Login = 1 Then
If InStr(.responseText, username) <> 0 Then '如果返回值里面有用户名,说明登录失败
MsgBox "登录失败"
Elseif InStr(.responseText, "验证码") <> 0 Then ’如果返回值有验证码，证明需要验证码
msgbox "登录失败，需要验证码"
else '反之
MsgBox "登录成功"
mycookie = GetCookie(.getAllResponseHeaders)
End If
End If
Else
'XMLHttpRequest = "Http错误代码:" & .Status
XMLHttpRequest = ""
End If
End With
Set MyXmlhttp = Nothing
Exit Function
wrong:
'XMLHttpRequest = "错误原因:" & Err.Description & ""
XMLHttpRequest = ""
Set MyXmlhttp = Nothing
End Function
下面我们添加一个按钮command1
在按钮的单击事件下加入如下代码
Private Sub Command1_Click() '特别需要注意的是 我这用的是wap登录方式 所以跟上面的图里的包不一样，但是操作步骤大家知道就行了
dim username as string '声明username存放用户名
dim pass as string '声明pass存放密码
username = UTF8EncodeURI("郎合") 调用utf8编码来对用户名编码，并放入username变量里
pass = "EBTOLS" '直接把密码放入pass变量里
Dim postdate
Login = 1
postdate = "login_verifycode=&aaa=%E7%A1%AE%E5%AE%9A&login_bdverify=&login_username=" & username & "&login_loginpass=" & pass & "&login_save=0&login_bdstoken=&login_bdtime=&login_is_wid=0&login_wid=&login=vc&u=http%3A%2F%2Fm.baidu.com%2F%3Faction%3Dlogin&tn=&tpl=wimn&ssid=0&from=0&bd_page_type=1&uid=wiaui_1330770221_1313&isphone=&login_username_input=" '看到这里就是我们分析的post的数据，把他放到postdate这里变量里
XMLHttpRequest("POST", "http://wappass.baidu.com/passport/", postdate) '把postdate变量里的数据提交到截包到的提交地址里
End Sub
获取关注必须的数据
我们先去截取一下要刷粉的包
然后看看post里需要哪些数据
多截取几次观察 我们发现有两个数据在变 一个是token 还有一个是portrait 这两个数据
所以我们得获取他，经过在源码里面查找 源码里面有这两个数据
所以下面我们来获取他
新建一个按钮command2
新建一个文本框text1 放入要关注的用户名
然后在按钮被单击的事件里写入如下代码
login=2
On Error Resume Next '如果出错继续下一步
Dim a111 As String
dim shuju as string
qwer ="\/portrait\/item\/" 获取数据的标示符
qwert =".jpg\" '同上
a111 = "http://www.baidu.com/p/" & Text1.Text & "?from=tieba"
shuju = XMLHttpRequest("GET", a111, "") '访问个人贴吧页面
Dim ss1
Dim ss
Dim arr1
Dim t
ss1 = """token"": '"
ss = Replace(shuju, """token"": '", ss1)
arr1 = Split(ss, ss1)
For t = 0 To UBound(arr1) - 1
token= Left(arr1(t + 1), InStr(arr1(t + 1), "', ""portrait"": ") - 1) '得到token数据
Next
Dim ss2
Dim ss3
Dim arr2
Dim y
ss2 = qwer
ss3 = Replace(shuju, qwer, ss2)
arr2 = Split(ss3, ss2)
For y = 0 To UBound(arr2) - 1
portrait = Left(arr2(y + 1), InStr(arr2(y + 1), qwert) - 1) '得到portrait数据
Next
获取数据完毕之后
我们再就要post关注数据额
新建一个按钮command3
在他被单击的时间输入如下代码
Dim postdate$
Dim p, qq
qq = Now '获取当前系统时间
qqq = DateDiff("s", "1970-1-1 08:00:00", qq) '获得时间戳
login =2
postdate = "token=" & token & "&portrait=" & portrait & "&from=tieba&action=add&t=" & qqq & ""
fanhuishuju = XMLHttpRequest("POST", "http://www.baidu.com/p/sys/submit/relation", postdate)
If InStr(fanhuishuju, "{errNo:""0""|") <> 0 Then
msgbox "关注成功
ElseIf InStr(fanhuishuju, "{errNo:""-1""|") <> 0 Then
msgbox "账号被封"
Else
msgbox "未知错误"
End If
|
|
发表于 2012-7-21 01:09:44
好长
