502647092/QzoneTalk
1
0
Fork 0
mirror of https://e.coding.net/circlecloud/QzoneTalk.git synced 2025-11-24 21:36:13 +00:00
Code Releases Activity

init project...

Browse Source 
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092
2015-06-25 17:05:02 +08:00
commit f13d97ffee
5 changed files with 5345 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

455
Frm_Main.frm Normal file
View File

@@ -0,0 +1,455 @@
VERSION 5.00
Begin VB.Form Frm_Main
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 3000
ClientLeft = 0
ClientTop = 0
ClientWidth = 4995
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3000
ScaleWidth = 4995
ShowInTaskbar = 0 'False
StartUpPosition = 2 '<27><>Ļ<EFBFBD><C4BB><EFBFBD><EFBFBD>
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.XmlHttp XmlHttp
Height = 240
Left = 3630
Top = 105
Visible = 0 'False
Width = 240
_ExtentX = 423
_ExtentY = 423
End
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.Frm_Tols Frm
Height = 240
Left = 3885
Top = 90
Visible = 0 'False
Width = 240
_ExtentX = 423
_ExtentY = 423
End
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.TzTab TzTab
Height = 3000
Left = 0
Top = 0
Width = 4995
_ExtentX = 8811
_ExtentY = 5292
TabBt = "$<24><>¼||$<24><>֤||$<24><><EFBFBD><EFBFBD>||#||#<23>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.TzButton clear
Height = 360
Left = 2.00000e5
Tag = "3"
Top = 510
Visible = 0 'False
WhatsThisHelpID = 2940
Width = 1500
_ExtentX = 2646
_ExtentY = 635
Caption = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
BackColor = 255
StartColor = 255
FinshColor = 8421631
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "<22><><EFBFBD><EFBFBD>"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox suffix
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 270
Left = 2.00000e5
TabIndex = 8
Tag = "3"
Top = 2640
Visible = 0 'False
WhatsThisHelpID = 915
Width = 2865
End
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.TzButton send
Height = 270
Left = 2.00000e5
Tag = "3"
Top = 2640
Visible = 0 'False
WhatsThisHelpID = 3885
Width = 930
_ExtentX = 1640
_ExtentY = 476
Caption = "<22><><EFBFBD><EFBFBD>"
BackColor = 33023
StartColor = 33023
FinshColor = 8438015
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "<22><><EFBFBD><EFBFBD>"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox content
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 1455
Left = 2.00000e5
TabIndex = 7
Tag = "3"
Top = 1095
Visible = 0 'False
WhatsThisHelpID = 150
Width = 4680
End
Begin VB.TextBox vc
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 250
Left = 2.00000e5
TabIndex = 4
Tag = "2"
Top = 975
Visible = 0 'False
WhatsThisHelpID = 1455
Width = 975
End
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.TzButton submit
Height = 585
Left = 2.00000e5
Tag = "2"
Top = 1710
Visible = 0 'False
WhatsThisHelpID = 1192
Width = 2610
_ExtentX = 4604
_ExtentY = 1032
Caption = "<22>ύ"
BackColor = 49344
StartColor = 49344
FinshColor = 65535
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "΢<><CEA2><EFBFBD>ź<EFBFBD>"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox password
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 250
IMEMode = 3 'DISABLE
Left = 1684
PasswordChar = "*"
TabIndex = 2
Tag = "1"
Top = 1410
WhatsThisHelpID = 1684
Width = 2500
End
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.TzButton Login
Height = 405
Left = 1605
Tag = "1"
Top = 1950
WhatsThisHelpID = 1605
Width = 1785
_ExtentX = 3149
_ExtentY = 714
Caption = "<22><>¼<EFBFBD>ֻ<EFBFBD>QQ"
BackColor = 49152
StartColor = 49152
FinshColor = 65280
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "<22><><EFBFBD><EFBFBD>"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox username
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 250
Left = 1684
TabIndex = 1
Tag = "1"
Top = 990
WhatsThisHelpID = 1684
Width = 2500
End
Begin <20>ֻ<EFBFBD>˵˵<CBB5><CBB5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.TzButton close
Height = 345
Left = 4650
Tag = "-1"
Top = 0
WhatsThisHelpID = 4650
Width = 345
_ExtentX = 609
_ExtentY = 609
Caption = "r"
BackColor = 192
StartColor = 192
FinshColor = 255
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Webdings"
Size = 9
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label4
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "Сβ<D0A1><CEB2>"
BeginProperty Font
Name = "΢<><CEA2><EFBFBD>ź<EFBFBD>"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Left = 2.00000e5
TabIndex = 9
Tag = "3"
Top = 2610
Visible = 0 'False
WhatsThisHelpID = 165
Width = 630
End
Begin VB.Label prefix
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "<22>û<EFBFBD><C3BB>dz<EFBFBD>"
BeginProperty Font
Name = "΢<><CEA2><EFBFBD>ź<EFBFBD>"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2.00000e5
TabIndex = 6
Tag = "3"
Top = 540
Visible = 0 'False
WhatsThisHelpID = 1140
Width = 960
End
Begin VB.Image headimg
Height = 600
Left = 2.00000e5
Tag = "3"
Top = 420
Visible = 0 'False
WhatsThisHelpID = 375
Width = 600
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "<22><>֤<EFBFBD><D6A4>"
BeginProperty Font
Name = "΢<><CEA2><EFBFBD>ź<EFBFBD>"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2.00000e5
TabIndex = 5
Tag = "2"
Top = 945
Visible = 0 'False
WhatsThisHelpID = 750
Width = 630
End
Begin VB.Image vcimg
Height = 600
Left = 2.00000e5
Tag = "2"
Top = 810
Visible = 0 'False
WhatsThisHelpID = 2520
Width = 1485
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "QQ<51><51><EFBFBD><EFBFBD>"
BeginProperty Font
Name = "΢<><CEA2><EFBFBD>ź<EFBFBD>"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 811
TabIndex = 3
Tag = "1"
Top = 1380
WhatsThisHelpID = 811
Width = 750
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "QQ<51>˺<EFBFBD>"
BeginProperty Font
Name = "΢<><CEA2><EFBFBD>ź<EFBFBD>"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 811
TabIndex = 0
Tag = "1"
Top = 960
WhatsThisHelpID = 811
Width = 750
End
End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim qq As String
Dim pwd As String
Dim sid As String
Dim r_sid As String
Dim nike As String
Dim headpic As String
Dim vcpic As String
Private Sub clear_Click()
content = ""
suffix = ""
End Sub
Private Sub close_Click()
Unload Me
End Sub
Private Function mids(str As String) As String
mids = Mid(str, 2, Len(str) - 2)
End Function
Private Sub Login_Click()
If Len(username) = 0 Then MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>QQ<51>˺ţ<CBBA>", 0, "<22><>ʾ": Exit Sub
If Len(password) = 0 Then MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>QQ<51><51><EFBFBD>룡", 0, "<22><>ʾ": Exit Sub
Call Analysis(flogin(username, password))
End Sub
Private Sub send_Click()
Dim tmp As String
tmp = content.Text
If Len(tmp) = 0 Then MsgBox "<22><><EFBFBD><EFBFBD>д<EFBFBD><D0B4><EFBFBD>ݣ<EFBFBD>", 0, "<22><>ʾ": Exit Sub
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, "<22><><EFBFBD>ȵ<EFBFBD>¼") Then
MsgBox strAlbum, 0, "<22><><EFBFBD><EFBFBD>˵˵ʧ<CBB5>ܣ<EFBFBD>"
TzTab.TabID = 1
Else
MsgBox "<22><><EFBFBD><EFBFBD>˵˵<CBB5>ɹ<EFBFBD><C9B9><EFBFBD>", 0, "<22><>ʾ"
End If
End Sub
Private Sub submit_Click()
If Len(vc) = 0 Then MsgBox "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>֤<EFBFBD>룡", 0, "<22><>ʾ": Exit Sub
Call Analysis(slogin(username, r_sid, vc))
End Sub
Public Function Analysis(ByVal strAlbum As String)
Dim arr() As String
arr = Split(strAlbum, ",")
Select Case arr(2)
Case 0 '<27><>½<EFBFBD>ɹ<EFBFBD>
qq = arr(1)
sid = mids(arr(4))
nike = mids(arr(5))
headpic = mids(arr(6))
headimg.Picture = XmlHttp.LoadPicture(headpic)
prefix = nike
TzTab.TabID = 3
Exit Function
Case 40001 '<27><>֤<EFBFBD><D6A4><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ҫ<EFBFBD><D2AA>֤<EFBFBD><D6A4>
r_sid = mids(arr(4))
vcpic = mids(arr(5)) & ".gif"
vcimg.Picture = XmlHttp.LoadPicture(vcpic)
TzTab.TabID = 2
Case 40010 '<27>˺<EFBFBD><CBBA><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
End Select
MsgBox arr(3), vbCritical, "<22><>½<EFBFBD><C2BD><EFBFBD><EFBFBD>!"
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))
End Function
Public Function slogin(ByVal qq As String, ByVal r_sid As String, ByVal vcode As String)
Dim PostData, PostUrl
PostUrl = "http://pt.3g.qq.com/login?act=json&format=3"
PostData = "bid_code=qqchatLogin&r_sid=" + r_sid + "&verify=" + vcode + "&u_token=" + qq + "&qq=" + qq + "&go_url=undefined"
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)
Frm.hMove (Me.hWnd)
End Sub
Private Sub vcimg_Click()
vcimg.Picture = XmlHttp.LoadPicture(vcpic)
End Sub