diff --git a/Frm_Main.frm b/Frm_Main.frm index 6b2a2fe..d8d84ce 100644 --- a/Frm_Main.frm +++ b/Frm_Main.frm @@ -11,7 +11,6 @@ Begin VB.Form Frm_Main MinButton = 0 'False ScaleHeight = 3000 ScaleWidth = 4995 - ShowInTaskbar = 0 'False StartUpPosition = 2 '屏幕中心 Begin 手机说说发表工具.XmlHttp XmlHttp Height = 240 @@ -39,6 +38,55 @@ Begin VB.Form Frm_Main _ExtentX = 8811 _ExtentY = 5292 TabBt = "$登录||$验证||$发表||#||#手机说说发表工具" + Begin 手机说说发表工具.TzCheck LoginType + Height = 300 + Index = 1 + Left = 2985 + Tag = "1" + Top = 1725 + WhatsThisHelpID = 2985 + Width = 1200 + _ExtentX = 2117 + _ExtentY = 529 + Caption = "3G 版本" + BackColor = 8421504 + StartColor = 8421504 + FinshColor = 12632256 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "宋体" + Size = 9 + Charset = 134 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + End + Begin 手机说说发表工具.TzCheck LoginType + Height = 300 + Index = 0 + Left = 1680 + Tag = "1" + Top = 1725 + WhatsThisHelpID = 1680 + Width = 1200 + _ExtentX = 2117 + _ExtentY = 529 + Caption = "触屏 版本" + BackColor = 8421504 + StartColor = 8421504 + FinshColor = 12632256 + BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} + Name = "宋体" + Size = 9 + Charset = 134 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Value = 1 + End Begin 手机说说发表工具.TzButton clear Height = 360 Left = 2.00000e5 @@ -111,7 +159,7 @@ Begin VB.Form Frm_Main WhatsThisHelpID = 150 Width = 4680 End - Begin VB.TextBox vc + Begin VB.TextBox vcT Appearance = 0 'Flat BorderStyle = 0 'None Height = 250 @@ -156,7 +204,7 @@ Begin VB.Form Frm_Main PasswordChar = "*" TabIndex = 2 Tag = "1" - Top = 1410 + Top = 1335 WhatsThisHelpID = 1684 Width = 2500 End @@ -167,7 +215,7 @@ Begin VB.Form Frm_Main Left = 1684 TabIndex = 1 Tag = "1" - Top = 990 + Top = 915 WhatsThisHelpID = 1684 Width = 2500 End @@ -198,15 +246,15 @@ Begin VB.Form Frm_Main Height = 405 Left = 1605 Tag = "1" - Top = 1950 + Top = 2130 WhatsThisHelpID = 1605 Width = 1785 _ExtentX = 3149 _ExtentY = 714 Caption = "登录手机QQ" - BackColor = 49152 - StartColor = 49152 - FinshColor = 65280 + BackColor = 32768 + StartColor = 32768 + FinshColor = 49152 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "宋体" Size = 9 @@ -217,6 +265,28 @@ Begin VB.Form Frm_Main Strikethrough = 0 'False EndProperty End + Begin VB.Label Label5 + AutoSize = -1 'True + BackStyle = 0 'Transparent + Caption = "登录模式" + BeginProperty Font + Name = "微软雅黑" + Size = 10.5 + Charset = 134 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00FFFFFF& + Height = 300 + Left = 810 + TabIndex = 10 + Tag = "1" + Top = 1710 + WhatsThisHelpID = 810 + Width = 840 + End Begin VB.Label Label4 Appearance = 0 'Flat AutoSize = -1 'True @@ -298,6 +368,7 @@ Begin VB.Form Frm_Main Begin VB.Image vcimg Height = 600 Left = 2.00000e5 + MousePointer = 11 'Hourglass Tag = "2" Top = 810 Visible = 0 'False @@ -317,12 +388,13 @@ Begin VB.Form Frm_Main Italic = 0 'False Strikethrough = 0 'False EndProperty + ForeColor = &H00FFFFFF& Height = 300 - Left = 811 + Left = 810 TabIndex = 3 Tag = "1" - Top = 1380 - WhatsThisHelpID = 811 + Top = 1305 + WhatsThisHelpID = 810 Width = 750 End Begin VB.Label Label1 @@ -338,12 +410,13 @@ Begin VB.Form Frm_Main Italic = 0 'False Strikethrough = 0 'False EndProperty + ForeColor = &H00FFFFFF& Height = 300 - Left = 811 + Left = 810 TabIndex = 0 Tag = "1" - Top = 960 - WhatsThisHelpID = 811 + Top = 885 + WhatsThisHelpID = 810 Width = 750 End End @@ -357,12 +430,15 @@ Option Explicit Dim qq As String Dim pwd As String Dim sid As String +Dim sig As String Dim r_sid As String Dim nike As String Dim headpic As String Dim vcpic As String +Dim vc As String + Private Sub clear_Click() content = "" suffix = "" @@ -381,7 +457,15 @@ Private Sub Login_Click() If Len(username) = 0 Then MsgBox "请输入QQ账号！", 0, "提示": Exit Sub If Len(password) = 0 Then MsgBox "请输入QQ密码！", 0, "提示": Exit Sub TzTab.TabID = 2 - Call Analysis(flogin(username, password)) + flogin username, password +End Sub + +Private Sub LoginType_Click(Index As Integer) + Dim i As Long + For i = LoginType.LBound To LoginType.UBound + LoginType(i).Value = UnCheck + Next + LoginType(Index).Value = Check End Sub Private Sub username_KeyPress(KeyAscii As Integer) @@ -396,14 +480,12 @@ Private Sub send_Click() Dim tmp As String tmp = content.Text If Len(tmp) = 0 Then MsgBox "请填写内容！", 0, "提示": Exit Sub - + tmp = XmlHttp.URLEncode(tmp) Dim PostData, PostUrl As String PostUrl = "http://m.qzone.com/mood/publish_mood" PostData = "opr_type=publish_shuoshuo&res_uin=" & qq & "&content=" & tmp & "&richval=&lat=0&lon=0&lbsid=&issyncweibo=0&format=json&sid=" & sid & "&is_winphone=2&source_name=" & suffix - Dim strAlbum As String strAlbum = XmlHttp.PostData(PostUrl, PostData, ResponseBodyToText, , False) - If InStr(1, strAlbum, "请先登录") Then MsgBox strAlbum, 0, "发表说说失败！" TzTab.TabID = 1 @@ -413,9 +495,14 @@ Private Sub send_Click() End Sub Private Sub submit_Click() - If Len(vc) = 0 Then MsgBox "请输入验证码！", 0, "提示": Exit Sub + If Len(vcT) = 0 Then MsgBox "请输入验证码！", 0, "提示": Exit Sub TzTab.TabID = 3 - Call Analysis(slogin(username, r_sid, vc)) + If LoginType(0).Value = UnCheck Then + Call Analysis(slogin(username, r_sid, vcT)) + Else + touchvc username, vcT + touchlogin username, password, vc + End If End Sub Public Function Analysis(ByVal strAlbum As String) @@ -444,13 +531,81 @@ Public Function Analysis(ByVal strAlbum As String) MsgBox arr(3), vbCritical, "登陆错误!" End Function +'http://check.ptlogin2.qzone.com/check?pt_tea=1&uin=502647092&appid=549000929 +'ptui_checkVC('1','0GIZj_RKBPvQ3Cg8N02-VZjcM9P55SmnmoKX8nAsHhDyh-pNqq1Uww**','\x00\x00\x00\x00\x1d\xf5\xc9\x34','','0'); +'http://captcha.qq.com/cap_union_show?captype=3&lang=2052&aid=549000929&uin=502647092&cap_cd=0GIZj_RKBPvQ3Cg8N02-VZjcM9P55SmnmoKX8nAsHhDyh-pNqq1Uww** + +'http://captcha.qq.com/getNewImgBySig?aid=549000929&uin=502647092&sig=ghT8AClEPgg7sccIyFHgiO0EK7k1pRXefWDtm0Grb2idFBN7U0yihlZliaAB7aXSASq_HgUxnUXwhlVsC6G5yEO-_VWBPJ4PNR0yx8_6usJE* +'http://captcha.qq.com/getimgbysig?aid=549000929&uin=502647092&sig=gxfRFOV1UOeuFWVd4ZPsM3i2BsAih4oTLuv8Ncs63d-MlWHe2sMnAdxeS7baUNi7h6OTVFqqzTgjhSdRzQDTT4swilNackk-kn7zXYYEB3FY* + +'http://captcha.qq.com/getQueSig?aid=549000929&uin=502647092&captype=2&sig=gxfRFOV1UOeuFWVd4ZPsM3i2BsAih4oTLuv8Ncs63d-MlWHe2sMnAdxeS7baUNi7h6OTVFqqzTgjhSdRzQDTT4swilNackk-kn7zXYYEB3FY*&0.1560081106144935 +'cap_setQue("",0);cap_showOption(""); cap_getCapBySig("gBLLRPu68q_0Uy9riC2SuXTKcw1AHNZjlmLz9Xyud6LlctgE_NCbO8GadL3eHGXLy3ko10JZRMFV4KHodcu-_3IgfMtsyBHIwjt9RxE6PgZk*"); +'http://captcha.qq.com/getimgbysig?aid=549000929&uin=502647092&sig=gBLLRPu68q_0Uy9riC2SuXTKcw1AHNZjlmLz9Xyud6LlctgE_NCbO8GadL3eHGXLy3ko10JZRMFV4KHodcu-_3IgfMtsyBHIwjt9RxE6PgZk* + +'http://captcha.qq.com/cap_union_verify?aid=549000929&uin=502647092&captype=2&ans=trmk&sig=gBLLRPu68q_0Uy9riC2SuXTKcw1AHNZjlmLz9Xyud6LlctgE_NCbO8GadL3eHGXLy3ko10JZRMFV4KHodcu-_3IgfMtsyBHIwjt9RxE6PgZk* +'cap_InnerCBVerify({rcode:5,randstr:"",sig:"",errmsg:"验证失败，请重试。"}); + +'http://captcha.qq.com/cap_union_verify?aid=549000929&uin=502647092&captype=2&ans=bygr&sig=gZ0qcmFuJCSXEDjyg42a2Nf40zfvaxvGL-C7htPCyBYT7fPjbfCYXIMR8_4zuacRtl2hxuzNdHCK2FNsJmkLduIatiNcKddigTKem3hEbQ5w* +'cap_InnerCBVerify({rcode:0,randstr:"@LSJ",sig:"t02hJBI1AWHUY3IVkL65-2MEmwfNyxpWJkr1R8VZfMjyXwegZ2Fo_5RNRqBKMRCZ8pPh_nGKuAurRj6J0bZ-fzFID1IdhsdOD-a",errmsg:"验证失败，请重试。"}); + +'http://ptlogin2.qzone.com/login?verifycode=@8HD&u=502647092&p=tmAR6MsWZUS1v6vJUQhKw9OUi7IjEWWpx0BUo4n39VhWE7dy14Co4AKGrb9ZP1oBSIwWY2OdXnjCqvmQYgL2xDFscjvuiQJ4L5ZQHtfiVIV-AyhjkIamgR90zhBznq8IpXDah2tW52UhqmjDOk0kHPUjg08JhHOrwU6h0pDknbfXJETwNjhMv01giTB73*ty4GDY1JhPsgpn6uuvlEDp6A__ _ + &pt_randsalt=0&ptlang=2052&low_login_enable=0&u1=http%3A%2F%2Fm.qzone.com%2Finfocenter%3Fg_f%3D&from_ui=1&fp=loginerroralert&device=2&aid=549000929&pt_ttype=1&pt_3rd_aid=0&ptredirect=1&h=1&g=1&pt_uistyle=9&pt_vcode_v1=1&pt_verifysession_v1=t02j2WOQ1sDfL05pk0HAo8FNM7_KzJyTkrS4zv8lxJbrJBoAeLsDLM3CmH9RWMNoEg69kx1zFOPE0ApvS8qUfKE-qe6kMck5pyJ& + +'ptuiCB('0','0','http://m.qzone.com/infocenter?g_f=&sid=Wh9SXy2ehSoykVA3sLGMLQvF+B+GtbgB1df5c9340201==','1','登录成功！', '‮喵↘呜'); + +'ptuiCB('4','2','','0','页面过期，请重试。(679477272)', '502647092'); + +Public Function getsid(ByVal html As String) + Dim st, en + st = InStr(1, html, "sid=") + Len("sid=") + en = InStr(st, html, "'") - 1 + getsid = Mid(html, st, en - st) +End Function + +Public Function AnalysisVC(ByVal str As String, vc As String, sig As String) + Dim st, en + If str = "" Then Exit Function + st = InStr(1, str, "randstr:""") + Len("randstr:""") + en = InStr(st, str, """") + vc = Mid(str, st, en - st) + st = InStr(en, str, "sig:""") + Len("sig:""") + en = InStr(st, str, """") + sig = Mid(str, st, en - st) +End Function + +Public Function AnalysisLG(ByVal str As String) + Dim st, en, yml + If str = "" Then Exit Function + st = InStr(1, str, "ptuiCB(") + Len("ptuiCB(") + en = InStr(st, str, ");") - 2 + yml = Mid(str, st, en - st) + Dim arr() As String + arr = Split(yml, ",") + Select Case mids(arr(3)) + Case 1 + sid = getsid(arr(2)) + TzTab.TabID = 3 + Case Else + MsgBox yml, vbCritical, "登录失败!" + TzTab.TabID = 1 + End Select +End Function + Public Function flogin(ByVal qq As String, ByVal pwd As String) As String - Dim PostData, PostUrl, pmd5 As String - Dim MD5 As New clsMD5 - pmd5 = MD5.DigestStrToHexStr(password) - PostUrl = "http://pt.3g.qq.com/login?act=json&format=3" - PostData = "bid_code=qqchatLogin&qq=" + qq + "&pmd5=" + pmd5 + "&go_url=undefined" - flogin = mids(XmlHttp.PostData(PostUrl, PostData, ResponseBodyToText)) + If LoginType(0).Value = UnCheck Then + Dim PostData, PostUrl, pmd5 As String + Dim MD5 As New clsMD5 + pmd5 = MD5.DigestStrToHexStr(password) + PostUrl = "http://pt.3g.qq.com/login?act=json&format=3" + PostData = "bid_code=qqchatLogin&qq=" + qq + "&pmd5=" + pmd5 + "&go_url=undefined" + Analysis mids(XmlHttp.PostData(PostUrl, PostData, ResponseBodyToText)) + Else + If vc = "" Then + TzTab.TabID = 2 + Else + touchlogin qq, pwd, vc + End If + End If End Function Public Function slogin(ByVal qq As String, ByVal r_sid As String, ByVal vcode As String) @@ -460,14 +615,88 @@ Public Function slogin(ByVal qq As String, ByVal r_sid As String, ByVal vcode As slogin = mids(XmlHttp.PostData(PostUrl, PostData, ResponseBodyToText)) End Function -Private Sub TzTab_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single) +Public Function touchvc(ByVal qq As String, ByVal vcode As String) + Dim vcurl As String + vcurl = "http://captcha.qq.com/cap_union_verify?aid=549000929&uin=" + qq + "&captype=2&ans=" + vcode + "&sig=" + sig + AnalysisVC XmlHttp.GetData(vcurl, ResponseBodyToText), vc, sig + touchvc = vc +End Function + +Public Function touchlogin(ByVal qq As String, ByVal pwd As String, ByVal vc As String) + Dim loginurl As String + Dim pwdsc As String + pwdsc = Script(pwd, qq, vc) + loginurl = "http://ptlogin2.qzone.com/login?verifycode={vc}&u={qq}&p={pwdmd5}&pt_randsalt=0&ptlang=2052&low_login_enable=0&u1=http%3A%2F%2Fm.qzone.com%2Finfocenter%3Fg_f%3D&from_ui=1&fp=loginerroralert&device=2&aid=549000929&pt_ttype=1&pt_3rd_aid=0&ptredirect=1&h=1&g=1&pt_uistyle=9&pt_vcode_v1=1&pt_verifysession_v1={sig}" + loginurl = Replace(loginurl, "{vc}", vc) + loginurl = Replace(loginurl, "{qq}", qq) + loginurl = Replace(loginurl, "{sig}", sig) + loginurl = Replace(loginurl, "{pwdmd5}", Script(qq, pwd, vc)) + AnalysisLG XmlHttp.GetData(loginurl, ResponseBodyToText) +End Function + +Private Function Script(pwd As String, username As String, vc As String) As String + Dim obj As Object + Set obj = CreateObject("MSScriptControl.ScriptControl") + obj.AllowUI = True + obj.Language = "JavaScript" + Dim jstx As String + jstx = LoadResString(1) + obj.AddCode jstx + Script = obj.Eval("getEncryption('" & pwd & "','" & username & "','" & vc & "');") + Set obj = Nothing +End Function + +Private Sub TzTab_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Frm.hMove (Me.hWnd) End Sub -Private Sub vc_KeyPress(KeyAscii As Integer) - If KeyAscii = 13 Then submit_Click +Private Sub username_LostFocus() + If LoginType(0).Value = UnCheck Then Exit Sub + Dim Data As String + Data = XmlHttp.GetData("http://check.ptlogin2.qzone.com/check?pt_tea=1&uin=" + username + "&appid=549000929", ResponseBodyToText) + Data = getmid(Data) + Dim arr() As String + arr = Split(Data, ",") + If mids(arr(0)) = 0 Then vc = mids(arr(1)): sig = mids(arr(3)) Else vc = "" + If mids(arr(0)) = 1 Then + Dim sigurl As String + sigurl = "http://captcha.qq.com/cap_union_show?captype=3&lang=2052&aid=549000929&uin=" + username + "&cap_cd=" + mids(arr(1)) + 'Debug.Print sigurl + sig = getsig(XmlHttp.GetData(sigurl, ResponseBodyToText)) + 'Debug.Print sig + vcimg_Click + End If End Sub +Public Function getsig(ByVal html As String) + Dim st, en + st = InStr(1, html, "g_click_cap_sig=""") + Len("g_click_cap_sig=""") + en = InStr(st, html, """") + getsig = Mid(html, st, en - st) +End Function + +Public Function getnewsig(ByVal html As String) + Dim st, en + st = InStr(1, html, "cap_getCapBySig(""") + Len("cap_getCapBySig(""") + en = InStr(st, html, """") + getnewsig = Mid(html, st, en - st) +End Function + +Public Function getmid(strAlbum As String) As String + getmid = Mid(strAlbum, InStr(1, strAlbum, "(") + 1, InStr(1, strAlbum, ")") - 1) +End Function + Private Sub vcimg_Click() + If LoginType(0).Value = Check Then + Dim sigurl As String + sigurl = "http://captcha.qq.com/getQueSig?aid=549000929&uin=" + username + "&captype=2&sig=" + sig + sig = getnewsig(XmlHttp.GetData(sigurl, ResponseBodyToText)) + vcpic = "http://captcha.qq.com/getimgbysig?aid=549000929&uin=502647092&sig=" + sig + End If + Debug.Print vcpic vcimg.Picture = XmlHttp.LoadPicture(vcpic) End Sub + +Private Sub vcT_KeyPress(KeyAscii As Integer) + If KeyAscii = 13 Then submit_Click +End Sub diff --git a/鎵嬫満璇磋鍙戣〃宸ュ叿.RES b/鎵嬫満璇磋鍙戣〃宸ュ叿.RES new file mode 100644 index 0000000..3776084 Binary files /dev/null and b/鎵嬫満璇磋鍙戣〃宸ュ叿.RES differ diff --git a/鎵嬫満璇磋鍙戣〃宸ュ叿.vbp b/鎵嬫満璇磋鍙戣〃宸ュ叿.vbp index 10c5399..80f65d0 100644 --- a/鎵嬫満璇磋鍙戣〃宸ュ叿.vbp +++ b/鎵嬫満璇磋鍙戣〃宸ュ叿.vbp @@ -1,11 +1,14 @@ Type=Exe -Form=Frm_Main.frm Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation +Reference=*\G{662901FC-6951-4854-9EB2-D9A2570F2B2E}#5.1#0#C:\Windows\system32\winhttp.dll#Microsoft WinHTTP Services, version 5.1 +Form=Frm_Main.frm UserControl=..\VB用户控件\TzTab.ctl UserControl=..\VB用户控件\XmlHttp.ctl UserControl=..\VB用户控件\TzButton.ctl UserControl=..\VB用户控件\Frm_Tols.ctl Class=clsMD5; clsMD5.cls +UserControl=..\VB用户控件\TzCheck.ctl +ResFile32="手机说说发表工具.RES" IconForm="Frm_Main" Startup="Frm_Main" HelpFile="" diff --git a/鎵嬫満璇磋鍙戣〃宸ュ叿.vbw b/鎵嬫満璇磋鍙戣〃宸ュ叿.vbw index ba086d2..1474d7e 100644 --- a/鎵嬫満璇磋鍙戣〃宸ュ叿.vbw +++ b/鎵嬫満璇磋鍙戣〃宸ュ叿.vbw @@ -1,6 +1,7 @@ -Frm_Main = 22, 22, 1358, 527, , 231, 65, 1630, 570, C -TzTab = 0, 0, 1336, 505, , 66, 66, 1465, 571, C -XmlHttp = 0, 0, 0, 0, C, 132, 132, 1468, 637, C +Frm_Main = 200, 77, 1536, 582, , 231, 65, 1630, 570, C +TzTab = 0, 0, 1336, 505, C, 66, 66, 1465, 571, C +XmlHttp = 88, 88, 1424, 593, C, 132, 132, 1468, 637, C TzButton = 0, 0, 0, 0, C, 154, 154, 1490, 659, C Frm_Tols = 44, 44, 1380, 549, C, 176, 176, 1512, 681, C clsMD5 = 0, 0, 0, 0, C +TzCheck = 0, 0, 0, 0, C, 0, 0, 0, 0, C