用VB实现SmartQQ机器人

这里为了便于介绍程序设计的流程，更多以代码形式给出，具体可用火狐浏览器的firebug插件来抓包分析，或者用谷歌浏览器的开发者工具进行抓包。抓包地址是：http://w.qq.com

第一步，是二维码，登录上面的网址我们可以看到一个二维码页面，那么如果要实现机器人，首先第一步必须完成登录，通过手机端的扫码。具体代码获取二维码方式如下：

获取二维码的链接：https://ssl.ptlogin2.qq.com/ptqrshow?appid=501004106&e=0&l=M&s=5&d=72&v=4&t=0.0001，这里的0.0001最好用随机数来。这里用0.0001或者其他参数都可以。

得到后我们需要下载二维码。VB的实现方式比较简单。

用这个函数，这是我个人写的：

 1 Function DownNetFile(ByVal nUrl As String, ByVal nFile As String)
 2     Dim XmlHttp, b() As Byte
 3     Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
 4     XmlHttp.Open "GET", nUrl, False
 5     XmlHttp.Send
 6     If XmlHttp.readyState = 4 Then
 7         b() = XmlHttp.ResponseBody
 8         Open nFile For Binary As #1
 9         Put #1, , b()
10         Close #1
11     End If
12
13     Set XmlHttp = Nothing
14 End Function

不妨让这个事件为getvcode。这个过程就是：

1  DownNetFile "https://ssl.ptlogin2.qq.com/ptqrshow?appid=501004106&e=0&l=M&s=5&d=72&v=4&t=" & GetRandom, App.Path & "\QQvcode.png" '下载二维码
2     Call PaintPng(App.Path & "\QQvcode.png", Picture1.hdc, 0, 0)

这里有个paintpng,这是一个模块，由于我们下载下来的二维码是png格式的，VB本身的图片控件是不支持png格式的，因此需要一个模块。

 1 Private Type GdiplusStartupInput
 2     GdiplusVersion As Long
 3     DebugEventCallback As Long
 4     SuppressBackgroundThread As Long
 5     SuppressExternalCodecs As Long
 6 End Type
 7 Private Enum GpStatus
 8     Ok = 0
 9     GenericError = 1
10     InvalidParameter = 2
11     OutOfMemory = 3
12     ObjectBusy = 4
13     InsufficientBuffer = 5
14     NotImplemented = 6
15     Win32Error = 7
16     WrongState = 8
17     Aborted = 9
18     FileNotFound = 10
19     ValueOverflow = 11
20     AccessDenied = 12
21     UnknownImageFormat = 13
22     FontFamilyNotFound = 14
23     FontStyleNotFound = 15
24     NotTrueTypeFont = 16
25     UnsupportedGdiplusVersion = 17
26     GdiplusNotInitialized = 18
27     PropertyNotFound = 19
28     PropertyNotSupported = 20
29 End Enum
30 Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
31 Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatus
32 Private Declare Function GdipDrawImage Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single) As GpStatus
33 Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
34 Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus
35 Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
36 Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal fileName As String, image As Long) As GpStatus
37 Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
38 Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
39 Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
40 Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
41
42 Dim gdip_Token&, gdip_pngImage&, gdip_Graphics&, Picname$
43
44 Public Sub PaintPng(ByVal sFileName As String, ByVal hdc As Long, ByVal mX As Long, ByVal mY As Long)
45     '显示PNG图片到指定的DC环境
46     '
47     'mX与mY单位为象素.
48     Dim lngHeight As Long, lngWidth As Long
49
50     Call GDI_Initialize
51
52     If GdipCreateFromHDC(hdc, gdip_Graphics) <> Ok Then
53         GdiplusShutdown gdip_Token
54     Else
55         Call GdipLoadImageFromFile(StrConv(GetShortName(sFileName), vbUnicode), gdip_pngImage)
56         Call GdipGetImageHeight(gdip_pngImage, lngHeight)   '
57         Call GdipGetImageWidth(gdip_pngImage, lngWidth)
58         Call GdipDrawImageRect(gdip_Graphics, gdip_pngImage, mX, mY, lngWidth, lngHeight)
59     End If
60
61     Call GDI_Terminate
62 End Sub
63
64 Private Sub GDI_Initialize()
65     Dim GpInput As GdiplusStartupInput
66
67     GpInput.GdiplusVersion = 1
68     gdip_Graphics = 0
69     gdip_pngImage = 0
70     If GdiplusStartup(gdip_Token, GpInput) <> Ok Then
71         Debug.Print "GDI初始失败！"
72 '        MsgBox "GDI初始失败！"
73     End If
74 End Sub
75
76 Private Sub GDI_Terminate()
77     GdipDisposeImage gdip_pngImage
78     GdipDeleteGraphics gdip_Graphics
79     GdiplusShutdown gdip_Token
80 End Sub
81
82 Private Function GetShortName(ByVal sLongFileName As String) As String
83     Dim lRetVal&, sShortPathName$
84     sShortPathName = Space(255)
85     Call GetShortPathName(sLongFileName, sShortPathName, 255)
86     If InStr(sShortPathName, Chr(0)) > 0 Then
87         GetShortName = Trim(Mid(sShortPathName, 1, InStr(sShortPathName, Chr(0)) - 1))
88     Else
89         GetShortName = Trim(sShortPathName)
90     End If
91 End Function

二维码获取到了，那么就需要判断是否扫码了，需要访问一个链接：

1 https://ssl.ptlogin2.qq.com//ptqrlogin?webqq_type=10&remember_uin=1&login2qq=1&aid=501004106&u1=http%3A%2F%2Fw.qq.com%2Fproxy.html%3Flogin2qq%3D1%26webqq_type%3D10&ptredirect=0&ptlang=2052&daid=164&from_ui=1&pttype=1&dumy=&fp=loginerroralert&action=0-0-" & (GetRandom * 900000 + 1000000) & "&mibao_css=m_webqq&t=undefined&g=1&js_type=0&js_ver=10141&login_sig=&pt_randsalt=0

在这个链接里会返回验证的状态，包括：正在验证，未失效，已失效。这里不再赘述。

如果认证成功，则会返回一个状态文本，里面包含QQ号，昵称，以及下一步我们将要访问的一个checkurl.

第二步：获取checkurl

VB如何提取这个checkurl呢？最简单的方法是字符串截取函数：

 1  On Error Resume Next
 2     Dim ptwebqqtemp As String
 3     Dim checkurltemp As String
 4     Dim checkurl As String
 5     ptwebqqtemp = FileStr(App.Path & "\Cookie.txt")
 6     checkurltemp = FileStr(App.Path & "\Data\Checkurl.txt")
 7     ptwebqq = Mid(ptwebqqtemp, InStr(1, ptwebqqtemp, "ptwebqq=") + Len("ptwebqq="), 64)
 8     checkurl = Mid(checkurltemp, InStr(1, checkurltemp, "http://"), InStr(InStr(1, checkurltemp, "http://"), checkurltemp, "'") - InStr(1, checkurltemp, "http://"))
 9     set_ini App.Path & "\Config\Config.ini", "QQ", "ptwebqq", ptwebqq
10     set_ini App.Path & "\Config\Config.ini", "QQ", "checkurl", checkurl

这里我给保存到了一个配置文件中了，用于后面使用。

第三步：在这一步中，我们要拿到了vfwebqq和ptwebqq这2个参数了。

这一次我们需要拿到vfwebqq.

1 Dim URL As String
2     Dim s As String
3     Dim t As String
4
5     getHtmlstr get_ini(App.Path & "\Config\Config.ini", "QQ", "checkurl", 500)
6     ptwebqq = get_ini(App.Path & "\Config\Config.ini", "QQ", "ptwebqq", 255)
7     URL = "http://s.web2.qq.com/api/getvfwebqq?ptwebqq=" & ptwebqq & "&clientid=53999199&psessionid=&t=" & script("function a(){var timestamp=new Date().getTime();return timestamp;}a();")
8     Httpget URL, "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", "vfwebqq"

这里有个时间戳，VB本身对这个处理能力是极差的，所以我们求助于js。

这里给出VB调用js的代码：

1 Public Function script(code As String) As String
2     Dim obj As Object
3     Set obj = CreateObject("MSScriptControl.ScriptControl")
4     obj.AllowUI = True
5     obj.Language = "JavaScript"
6     script = obj.Eval(code)
7 End Function

这个代码是执行js中代码的函数，写的很简单。

第四步：是最为关键的一步，因为在这里我们还有第二次登录。需要用到一个参数ptwebqq。需要用到的部分值在前一次访问返回的cookie中，VB对cookie的操作方法极少，我使用的是inet控件的一个方法.

获取psessionid.

1  Dim url1 As String
2     Dim Data As String
3     Dim psessionidtemp As String
4     psessionidtemp = FileStr(App.Path & "\Data\SecondLogin.txt")
5     url1 = "http://d1.web2.qq.com/channel/login2"
6     Data = "r=%7B%22ptwebqq%22%3A%22" & ptwebqq & "%22%2C%22clientid%22%3A53999199%2C%22psessionid%22%3A%22%22%2C%22status%22%3A%22online%22%7D"
7     Httppost url1, "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", Data, "Secondlogin"
8     psessionid = Mid(psessionidtemp, InStr(1, psessionidtemp, "psessionid"":""") + Len("psessionid"":"""), 224)

第五步：到这里我们已经完成了基本的登录了，包括第一次上线和正式登录。

在此之前我们需要一个函数，就是hash。VB自身没有这个函数，为此在写这个函数不值得，腾讯关于此算法也是经常换，因此我们直接从腾讯的SmartQQ官网的js文件中直接提取用我们前面提到的js函数来执行加密。

函数如下：

 1 Function Hash() As String                                                       'HASH
 2     Hash = "function hashU(x, K) {" & _
 3     "x += """";" & _
 4     "for (var N = [], T = 0; T < K.length; T++) N[T % 4] ^= K.charCodeAt(T);" & _
 5     " var U = [""EC"", ""OK""]," & _
 6     "V = [];" & _
 7     "V[0] = x >> 24 & 255 ^ U[0].charCodeAt(0);" & _
 8     "V[1] = x >> 16 & 255 ^ U[0].charCodeAt(1);" & _
 9     "V[2] = x >> 8 & 255 ^ U[1].charCodeAt(0);" & _
10     " V[3] = x & 255 ^ U[1].charCodeAt(1);" & _
11     " U = [];" & _
12     "for (T = 0; T < 8; T++) U[T] = T % 2 == 0 ? N[T >> 1] : V[T >> 1];" & _
13     "N = [""0"", ""1"", ""2"", ""3"", ""4"", ""5"", ""6"", ""7"", ""8"", ""9"", ""A"", ""B"", ""C"", ""D"", ""E"", ""F""];" & _
14     "V = """";" & _
15     "for (T = 0; T < U.length; T++) {" & _
16     "V += N[U[T] >> 4 & 15];" & _
17     " V += N[U[T] & 15]" & _
18     "  } " & _
19     " return V;" & _
20     "};"
21 End Function

这一次我们获取好友列表、个人信息、讨论组、群信息等：

获取好友列表：

1     Dim URL As String
2     Dim Data As String
4     vfwebqq = Mid(FileStr(App.Path & "\Data\vfwebqq.txt"), InStr(1, FileStr(App.Path & "\Data\vfwebqq.txt"), "vfwebqq"":""") + Len("vfwebqq"":"""), 80)
5     URL = "http://s.web2.qq.com/api/get_user_friends2"
7     Data = "r=%7B%22vfwebqq%22%3A%22" & vfwebqq & "%22%2C%22hash%22%3A%22" & script(Hash & vbCrLf & "hashU(""" & qq & """,""" & ptwebqq & """);") & "%22%7D"
8     Httppost URL, "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", Data, "GetFriendList"

获取个人信息：

1     Dim URL As String
2     URL = "http://s.web2.qq.com/api/get_self_info2?t=" & script("function a(){var timestamp=new Date().getTime();return timestamp;}a();")
3     Httpget URL, "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", "UserInformation" '获得个人信息
4     face = getface(FileStr(App.Path & "\Data\UserInformation.txt"))
5     qq = getqq(FileStr(App.Path & "\Data\UserInformation.txt"))

获取讨论组信息：

1     Dim URL As String
2     URL = "http://s.web2.qq.com/api/get_discus_list?clientid=53999199&psessionid=" & psessionid & "&vfwebqq=" & vfwebqq & "&t=" & script("function a(){var timestamp=new Date().getTime();return timestamp;}a();")
3     Httpget URL, "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", "DiscussList" '获得讨论组信息

获取群信息：

1     Dim URL As String
2     Dim Data As String
3     Data = "r=%7B%22vfwebqq%22%3A%22" & vfwebqq & "%22%2C%22hash%22%3A%22" & script(Hash & vbCrLf & "hashU(""" & qq & """,""" & ptwebqq & """);") & "%22%7D"
4     URL = "http://s.web2.qq.com/api/get_group_name_list_mask2"
5     Httppost URL, "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", Data, "Grouplist"

获取最近联系人的相关信息：

1     Dim URL As String
2     URL = "http://d1.web2.qq.com/channel/get_recent_list2"
3     Httpget URL, "http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2", "RencentList" '获得讨论组信息

第六步：

我们已经获取了相关信息，最重要的一步就是接收消息：

1 URL = "http://d1.web2.qq.com/channel/poll2"
2     Data = "r=%7B%22ptwebqq%22%3A%22" & ptwebqq & "%22%2C%22clientid" & _
3     "%22%3A53999199%2C%22psessionid%22%3A%22" & psessionid & "%22%2C%22key%22%3A%22%22%7D"
4     Inet2.Execute URL, "post", Data, "Content-Type: application/x-www-form-urlencoded" & vbCrLf & "Referer:http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2"
5     Do While Inet2.StillExecuting
6         DoEvents
7     Loop
8     binbuff() = Inet2.GetChunk(0, icByteArray)
9     m = Utf8ToUnicode(binbuff)

这里我使用的是一个inet2的控件，它用于接收消息的，所用到的参数在前面的步骤中我们已经获取到了，唯一需要注意的是返回的是utf-8格式的需要转换，我给出一个转换函数：

 1 Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
 2 Private Const CP_UTF8 = 65001
 3 Function Utf8ToUnicode(ByRef Utf() As Byte) As String
 4     Dim lRet As Long
 5     Dim lLength As Long
 6     Dim lBufferSize As Long
 7     lLength = UBound(Utf) - LBound(Utf) + 1
 8     If lLength <= 0 Then Exit Function
 9     lBufferSize = lLength * 2
10     Utf8ToUnicode = String$(lBufferSize, Chr(0))
11     lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
12     If lRet <> 0 Then
13         Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
14     Else
15         Utf8ToUnicode = ""
16     End If
17 End Function

注意前面的全部返回数据包均为utf-8格式的，均需要此函数进行转换。

在返回消息时可能会遇到retcode为103之类的。这时需要登录网页版的smartqq，然后退出，再回来登录我们用VB写的程序就行了。个人认为可能是腾讯的一个保护机制。

第七步：在第六步中，我已经将接收消息的过程写好了，那么还有一个重要的事就是发送消息。这个很容易实现，然而很遗憾的是这个SmartQQ协议阉割的东西太多了。能发送的只有文字和部分标签，这里我就不对表情的代码进行解析了，都是(face,id)。

具体代码如下：

 1 If lb = "个人" Then
 2 URL = "https://d1.web2.qq.com/channel/send_buddy_msg2"
 3     Data = "r=%7B%22to%22%3A" & uin & "%2C%22content%22%3A%22%5B%5C%22" & UTF8_URLEncoding(fsxx) & "%5C%22%2C%5B%5C%22font%5C%22%2C%7B%5C%22name" & _
 4     "%5C%22%3A%5C%22%E5%AE%8B%E4%BD%93%5C%22%2C%5C%22size%5C%22%3A10%2C%5C%22style%5C%22%3A%5B0%2C0%2C0%5D" & _
 5     "%2C%5C%22color%5C%22%3A%5C%22000000%5C%22%7D%5D%5D%22%2C%22face%22%3A726%2C%22clientid%22%3A53999199" & _
 6     "%2C%22msg_id%22%3A" & id & "%2C%22psessionid%22%3A%22" & psessionid & "%22%7D"
 7     End If
 8 If lb = "讨论组" Then
 9     URL = "https://d1.web2.qq.com/channel/send_discu_msg2"
10     Data = "r=%7B%22did%22%3A" & uin & "%2C%22content%22%3A%22%5B%5C%22" & UTF8_URLEncoding(fsxx) & "%5C%22%2C%5B%5C%22font%5C%22%2C%7B%5C%22name" & _
11     "%5C%22%3A%5C%22%E5%AE%8B%E4%BD%93%5C%22%2C%5C%22size%5C%22%3A10%2C%5C%22style%5C%22%3A%5B0%2C0%2C0%5D" & _
12     "%2C%5C%22color%5C%22%3A%5C%22000000%5C%22%7D%5D%5D%22%2C%22face%22%3A" & face & "%2C%22clientid%22%3A53999199" & _
13     "%2C%22msg_id%22%3A" & id & "%2C%22psessionid%22%3A%22" & psessionid & "%22%7D"
14 End If
15 If lb = "群" Then
16     URL = "https://d1.web2.qq.com/channel/send_qun_msg2"
17     Data = "r=%7B%22group_uin%22%3A" & uin & "%2C%22content%22%3A%22%5B%5C%22" & UTF8_URLEncoding(fsxx) & "%5C%22%2C%5B%5C%22font%5C%22%2C%7B%5C%22name" & _
18     "%5C%22%3A%5C%22%E5%AE%8B%E4%BD%93%5C%22%2C%5C%22size%5C%22%3A10%2C%5C%22style%5C%22%3A%5B0%2C0%2C0%5D" & _
19     "%2C%5C%22color%5C%22%3A%5C%22000000%5C%22%7D%5D%5D%22%2C%22face%22%3A" & face & "%2C%22clientid%22%3A53999199" & _
20     "%2C%22msg_id%22%3A" & id & "%2C%22psessionid%22%3A%22" & psessionid & "%22%7D"
21 End If

发送消息使用的是“post”方法。fsxx为发送的消息。

这里我用if-endif实现的，其实这样写不够简洁，可以考虑用select-case来实现，lb是我在接收消息中定义的一个全局变量因为我们需要知道消息来自哪里，不仅仅是lb还有发送者的uin。这里的uin是一个临时使用的编号，每个人、群、讨论组都是只有一天有效期的。所以如果做QQ机器人，我们需要将uin转为QQ号。具体实现方法如下：

1 Httpget "http://s.web2.qq.com/api/get_friend_uin2?tuin=" & uin & "&type=1&vfwebqq=" & vfwebqq & "&t=" & script("function a(){var timestamp=new Date().getTime();return timestamp;}a();"), "http://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1", "GetRealQQ" '这是获取真实的qq或者群号

在返回的json数据包中解析即可。这里也给出json的解析方式。

以获取face值为例

 1 Function getface(jsoncode As String) As String '这是json的解析函数
 2     On Error GoTo a
 3     Dim ScriptObj As Object
 4     Set ScriptObj = CreateObject("MSScriptControl.ScriptControl")
 5     ScriptObj.AllowUI = True
 6     ScriptObj.Language = "JavaScript"
 7     ScriptObj.AddCode "var data = " & jsoncode & ";"
 8     getface = ScriptObj.Eval("data.result.face")
 9 a:
10     Exit Function '如果出错了就退出函数
11 End Function

其他的修改eval()即可。

到这里已经将SmartQQ的全部协议过程解析完。可以借助此协议设计相关的QQ机器人。

转载于:https://www.cnblogs.com/onedayismway/p/6169904.html

用VB实现SmartQQ机器人相关推荐

vex夹球机器人_下一站，VEX机器人世界锦标赛！
原标题:下一站,VEX机器人世界锦标赛! 今天一号君带你了解一项在美国乃至国际都具有非凡影响力的青少年教育机器人项目-VEX机器人世界锦标赛! 作为获得吉尼斯世界纪录认证的赛事 VEX系列项目在国 ...
基于SmartQQ协议的QQ聊天机器人-7
本节的主题是:记录遇到的错误: 1. SQLite报错很奇葩的错误: 当时在main里面测试OK,但是把它封装成一个包,外部调用它,就报下面的错误: SQL logic error or missi ...
smartqq的开源机器人实现管理系统信息推送qq群
smartqq介绍: http://w.qq.com/ 在线WebQQ网页平台是腾讯在WebOS云平台上推出的一款单纯的聊天工具. SmartQQ JAVA开源项目: https://github. ...
QBot：基于SmartQQ协议的QQ机器人
一.介绍 qqbot 是一个用 python 实现的.基于腾讯 SmartQQ 协议的 QQ 机器人框架,可运行在 Linux . Windows 和 Mac OSX 平台下. 本项目 github ...
smartqq协议java_基于SmartQQ协议的QQ聊天机器人-3
今天的主题是:针对[消息回复模块]的代码分析及问题记录. 1. 核心文件分析: 核心是:QQService.java.SmartQQClient.java.Application.java.需要搞清楚 ...
smartqq java撤回_基于SmartQQ协议的QQ自动回复机器人-1
1. 软件安装:[myeclipse6.0 + maven2] 0. https://blog.csdn.net/zgmzyr/article/details/6886440 1. https://b ...
基于SmartQQ协议的QQ聊天机器人-6
本节的主题是:记录功能实现的过程中的难点及踩坑经历 1. 大麻烦: SmartQQ协议不支持长文本,字数限制在200字左右(粗略测试的结果) 我本来想到一个好主意:把[带图片的长文本答案]转[图片], ...
基于SmartQQ协议的QQ聊天机器人-5
本节主题是项目回顾,从总体上分析QQ机器人的数据流 1. 项目的生命周期: /*** 下面是我的理解和注释:* 本模块功能:提供各种qq服务的基础函数库 * 项目的运行流程是:* 比如,我现在1.0版 ...
基于SmartQQ协议的QQ聊天机器人-4
本节的主题是:结合上节的分析,具体分析函数的实现 1. 回复消息模块: 集中在org.b3log.xiaov.service包.主控文件是QQService.java,其他只是回复算法的api和一些支 ...

用VB实现SmartQQ机器人

用VB实现SmartQQ机器人相关推荐

最新文章

热门文章