找回密码
 立即注册
查看: 2461|回复: 22

vb刷粉机制作教程 by轻风

[复制链接]

1196

回帖

5083

基友

6356

积分

通神6段 Lv.9

Rank: 5Rank: 5

发表于 2012-7-21 01:09:44 | 显示全部楼层 |阅读模式
本帖最后由 飞龙 于 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
回复

使用道具 举报

378

回帖

8020

基友

5539

积分

萨菲尔斯

Rank: 17Rank: 17Rank: 17Rank: 17Rank: 17

伯爵荣耀

发表于 2012-8-2 11:40:28 | 显示全部楼层
追回版权,这是轻风写的
啊啊啊啊啊啊
回复 支持 反对

使用道具 举报

378

回帖

8020

基友

5539

积分

萨菲尔斯

Rank: 17Rank: 17Rank: 17Rank: 17Rank: 17

伯爵荣耀

发表于 2012-8-5 00:58:35 来自手机 | 显示全部楼层
还有,其中源码有几个错误,如果按照上面的做会失败的,还有图片都不带。。。←_←
回复 支持 反对

使用道具 举报

119

回帖

285

基友

444

积分

凡人3阶 Lv.3

Rank: 2

发表于 2012-10-31 20:46:12 | 显示全部楼层
压梨山大,好复杂的样子!
回复 支持 反对

使用道具 举报

1万

回帖

2万

基友

5万

积分

苍海之魂

S̲̅F

Rank: 13Rank: 13Rank: 13Rank: 13

苍海的女仆会员纪念勋章周年纪念勋章

发表于 2012-11-7 22:35:54 | 显示全部楼层
好长
回复 支持 反对

使用道具 举报

40

回帖

191

基友

216

积分

凡人3阶 Lv.3

Rank: 2

发表于 2012-11-21 10:08:36 | 显示全部楼层
好长呀
回复 支持 反对

使用道具 举报

40

回帖

191

基友

216

积分

凡人3阶 Lv.3

Rank: 2

发表于 2012-11-21 10:08:46 | 显示全部楼层
好长呀
回复 支持 反对

使用道具 举报

198

回帖

1960

基友

1247

积分

通神3段 Lv.6

Rank: 3Rank: 3

伯爵荣耀

发表于 2012-12-8 19:51:02 | 显示全部楼层
楼上的都是什么心态,这么一点代码也嫌长 = =
每天的感觉都是不一样的,如此新鲜!
回复 支持 反对

使用道具 举报

37

回帖

234

基友

237

积分

凡人3阶 Lv.3

Rank: 2

发表于 2012-12-12 11:39:27 | 显示全部楼层
学习了
回复 支持 反对

使用道具 举报

379

回帖

3186

基友

2049

积分

通神4段 Lv.7

Rank: 4

发表于 2013-2-12 02:26:16 | 显示全部楼层
回复 支持 反对

使用道具 举报

256

回帖

31

基友

748

积分

通神2段 Lv.5

Rank: 3Rank: 3

发表于 2013-2-15 01:33:39 | 显示全部楼层
表示看不懂。。
回复 支持 反对

使用道具 举报

459

回帖

1514

基友

2139

积分

通神4段 Lv.7

Rank: 4

伯爵荣耀

发表于 2013-2-15 15:18:46 | 显示全部楼层
好贴啊~果断顶了
回复 支持 反对

使用道具 举报

12

回帖

96

基友

91

积分

凡人2阶 Lv.2

Rank: 1

伯爵荣耀

发表于 2013-2-15 21:39:14 | 显示全部楼层
我竟然看懂了……
回复 支持 反对

使用道具 举报

305

回帖

866

基友

1496

积分

通神3段 Lv.6

Rank: 3Rank: 3

伯爵荣耀

发表于 2013-2-17 12:48:41 | 显示全部楼层
不懂- -
回复 支持 反对

使用道具 举报

13

回帖

60

基友

134

积分

凡人2阶 Lv.2

Rank: 1

伯爵荣耀

发表于 2013-2-17 13:07:53 | 显示全部楼层
我自己有代码,哦也
回复 支持 反对

使用道具 举报

17

回帖

126

基友

133

积分

凡人2阶 Lv.2

Rank: 1

伯爵荣耀

QQ
发表于 2013-2-22 12:05:49 | 显示全部楼层
新人求教  可以发给我吗344154233@qq.com 谢谢了
回复 支持 反对

使用道具 举报

45

回帖

150

基友

196

积分

凡人2阶 Lv.2

Rank: 1

伯爵荣耀

发表于 2013-3-11 12:41:50 | 显示全部楼层
我自己有代码,哦也
回复 支持 反对

使用道具 举报

54

回帖

291

基友

252

积分

凡人3阶 Lv.3

Rank: 2

发表于 2013-3-12 03:17:05 | 显示全部楼层
学习啦。!
回复 支持 反对

使用道具 举报

201

回帖

2514

基友

1300

积分

通神3段 Lv.6

Rank: 3Rank: 3

伯爵荣耀

发表于 2013-3-17 15:46:54 | 显示全部楼层
我要升级快点帮我   
回复 支持 反对

使用道具 举报

201

回帖

2514

基友

1300

积分

通神3段 Lv.6

Rank: 3Rank: 3

伯爵荣耀

发表于 2013-3-17 15:47:33 | 显示全部楼层
怎么才能快点升级啊
回复 支持 反对

使用道具 举报

201

回帖

2514

基友

1300

积分

通神3段 Lv.6

Rank: 3Rank: 3

伯爵荣耀

发表于 2013-3-17 15:48:21 | 显示全部楼层
求升级啊
回复 支持 反对

使用道具 举报

18

回帖

16

基友

89

积分

凡人2阶 Lv.2

Rank: 1

发表于 2013-4-1 14:56:32 | 显示全部楼层
好难好难  看不懂
回复 支持 反对

使用道具 举报

163

回帖

121

基友

778

积分

通神2段 Lv.5

Rank: 3Rank: 3

发表于 2013-4-9 10:25:47 | 显示全部楼层
我是来求马甲的 。
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|苍海国际 ( 鲁ICP备13020644号-1 )

GMT+8, 2024-11-1 07:16 , Processed in 0.070367 second(s), 24 queries .

Powered by Discuz! Theme By eRic Modified by 4bpa

© CangHai International We Do Our Rights!

返回顶部