更新触屏版登录模块...

Signed-off-by: j502647092 <jtb1@163.com>

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
+         BackColor       =   32768
-         StartColor      =   49152
+         StartColor      =   32768
-         FinshColor      =   65280
+         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
+         Top             =   1305
-         WhatsThisHelpID =   811
+         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
+         Top             =   885
-         WhatsThisHelpID =   811
+         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
+    If LoginType(0).Value = UnCheck Then
-    Dim MD5 As New clsMD5
+        Dim PostData, PostUrl, pmd5 As String
-    pmd5 = MD5.DigestStrToHexStr(password)
+        Dim MD5 As New clsMD5
-    PostUrl = "http://pt.3g.qq.com/login?act=json&format=3"
+        pmd5 = MD5.DigestStrToHexStr(password)
-    PostData = "bid_code=qqchatLogin&qq=" + qq + "&pmd5=" + pmd5 + "&go_url=undefined"
+        PostUrl = "http://pt.3g.qq.com/login?act=json&format=3"
-    flogin = mids(XmlHttp.PostData(PostUrl, PostData, ResponseBodyToText))
+        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)
+Private Sub username_LostFocus()
-    If KeyAscii = 13 Then submit_Click
+    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

手机说说发表工具.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=""

手机说说发表工具.vbw

@@ -1,6 +1,7 @@
-Frm_Main = 22, 22, 1358, 527, , 231, 65, 1630, 570, C
+Frm_Main = 200, 77, 1536, 582, , 231, 65, 1630, 570, C
-TzTab = 0, 0, 1336, 505, , 66, 66, 1465, 571, C
+TzTab = 0, 0, 1336, 505, C, 66, 66, 1465, 571, C
-XmlHttp = 0, 0, 0, 0, C, 132, 132, 1468, 637, 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