外挂编程

开发平台：
Visual Basic

QQLogin.frm：源码内容
							VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form QQLogin 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "QQ登录"
   ClientHeight    =   3345
   ClientLeft      =   2835
   ClientTop       =   3375
   ClientWidth     =   4800
   Icon            =   "QQLogin.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1976.337
   ScaleMode       =   0  'User
   ScaleWidth      =   4506.941
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   1800
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   600
      Top             =   120
   End
   Begin VB.TextBox Text3 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   355
      IMEMode         =   3  'DISABLE
      Left            =   480
      MaxLength       =   4
      TabIndex        =   3
      Top             =   2160
      Width           =   855
   End
   Begin VB.Frame Frame1 
      Caption         =   "用户登陆"
      ForeColor       =   &H000000FF&
      Height          =   3135
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4558
      Begin VB.Timer Timer3 
         Interval        =   1000
         Left            =   1080
         Top             =   720
      End
      Begin InetCtlsObjects.Inet Inet1 
         Left            =   120
         Top             =   600
         _ExtentX        =   1005
         _ExtentY        =   1005
         _Version        =   393216
      End
      Begin VB.Timer Timer5 
         Enabled         =   0   'False
         Interval        =   5000
         Left            =   0
         Top             =   0
      End
      Begin MSWinsockLib.Winsock Winsock4 
         Left            =   3480
         Top             =   0
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         RemotePort      =   5
      End
      Begin MSWinsockLib.Winsock Winsock3 
         Left            =   2880
         Top             =   0
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         RemotePort      =   5
      End
      Begin VB.Timer Timer1 
         Enabled         =   0   'False
         Interval        =   10
         Left            =   1080
         Top             =   0
      End
      Begin MSWinsockLib.Winsock Winsock2 
         Left            =   2280
         Top             =   0
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
      Begin QQ伴侣.XPButton2 XPButton21 
         Height          =   345
         Left            =   3480
         TabIndex        =   13
         Top             =   240
         Width           =   690
         _ExtentX        =   1217
         _ExtentY        =   609
         Caption         =   "清除"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Verdana"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin QQ伴侣.XPButton2 XPButton2 
         Cancel          =   -1  'True
         Height          =   375
         Left            =   3220
         TabIndex        =   12
         Top             =   2600
         Width           =   975
         _ExtentX        =   1720
         _ExtentY        =   661
         Caption         =   "退出"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Verdana"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin QQ伴侣.XPButton2 XPButton1 
         Default         =   -1  'True
         Height          =   375
         Left            =   360
         TabIndex        =   11
         Top             =   2595
         Width           =   975
         _ExtentX        =   1720
         _ExtentY        =   661
         Caption         =   "登录"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Verdana"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.PictureBox Picture2 
         BorderStyle     =   0  'None
         Height          =   265
         Left            =   360
         ScaleHeight     =   270
         ScaleWidth      =   1455
         TabIndex        =   9
         Top             =   1200
         Width           =   1455
         Begin VB.CheckBox Check1 
            Caption         =   "保存登陆"
            Height          =   255
            Left            =   0
            TabIndex        =   10
            Top             =   0
            Value           =   1  'Checked
            Width           =   1215
         End
      End
      Begin VB.PictureBox Picture1 
         BorderStyle     =   0  'None
         Height          =   860
         Left            =   2200
         MouseIcon       =   "QQLogin.frx":058A
         MousePointer    =   99  'Custom
         ScaleHeight     =   855
         ScaleWidth      =   1995
         TabIndex        =   8
         Top             =   1560
         Visible         =   0   'False
         Width           =   2000
      End
      Begin VB.ComboBox Combo1 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         IMEMode         =   3  'DISABLE
         Left            =   1320
         TabIndex        =   1
         Text            =   "输入QQ号码"
         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox Text2 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1320
         MaxLength       =   21
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   720
         Width           =   2845
      End
      Begin QQ伴侣.Downloader Downloader1 
         Left            =   3960
         Top             =   0
         _ExtentX        =   847
         _ExtentY        =   847
      End
      Begin VB.Label Label4 
         Alignment       =   2  'Center
         Caption         =   "代理设置"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   3350
         MouseIcon       =   "QQLogin.frx":06DC
         MousePointer    =   99  'Custom
         TabIndex        =   16
         Top             =   1230
         Width           =   885
      End
      Begin VB.Label Label3 
         Alignment       =   2  'Center
         Caption         =   "加载中..."
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   2400
         TabIndex        =   15
         Top             =   1680
         Width           =   1815
      End
      Begin VB.Label Label7 
         Caption         =   "换一个"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   1440
         MouseIcon       =   "QQLogin.frx":082E
         MousePointer    =   99  'Custom
         TabIndex        =   7
         Top             =   2160
         Width           =   735
      End
      Begin VB.Label Label6 
         Caption         =   "请输入右边的验证码："
         Height          =   375
         Left            =   360
         TabIndex        =   6
         Top             =   1680
         Width           =   1935
      End
      Begin VB.Label Label2 
         Caption         =   "QQ密码："
         Height          =   255
         Left            =   360
         TabIndex        =   5
         Top             =   840
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "QQ号码："
         Height          =   255
         Left            =   360
         TabIndex        =   4
         Top             =   360
         Width           =   855
      End
   End
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   735
      Left            =   1680
      TabIndex        =   14
      Top             =   4440
      Width           =   1455
      ExtentX         =   2566
      ExtentY         =   1296
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
End
Attribute VB_Name = "QQLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MTime As Integer
Dim i As Integer
Dim js As Integer
'========获取验证码==========
Dim mintFile As Integer     '文件句柄
Dim mblnBegin As Boolean    '记录是否是第一次取得数据
Dim DownGifSize As Long     '已下载的文件大小
Dim GifSize As Long         '文件大小
'========获取验证码==========
Dim login_temp As String
Dim yzmcookie As String
Dim login_qq As Boolean     '记录是否第一次取得数据
Dim login2 As Boolean       '检测是否失败
Dim qqsum As Integer
Dim tqq(50) As String
Dim tmm(50) As String
Dim deletei As Integer
Dim Data_yzm As String
Dim cs As Integer
Dim Farmlx As Integer
Private Sub Combo1_Click()
    On Error Resume Next
    Text2.Text = tmm(Combo1.ListIndex + deletei)
    Text3.SetFocus
End Sub
Private Sub Label4_Click()
    QQLogin.Visible = False
    Form6.Check1.value = Proxy
    Form6.Text1.Text = Proxy_IP
    If Len(Proxy_U) > 0 Then Form6.Text3.Text = Proxy_U
    If Len(Proxy_P) > 0 Then Form6.Text4.Text = Proxy_P
    If Proxy_DK > 0 Then Form6.Text2.Text = Proxy_DK
    Form6.Show vbModal, Me
    Unload QQLogin
End Sub
Private Sub Timer1_Timer()
    On Error Resume Next
    Dim t1 As String, t2 As String
    Dim szini() As String
    Dim sum As Integer
    Dim q() As String
    Dim p() As String
    Dim TTime As String
    
  
    Combo1.Clear
    Timer1.Enabled = False
    
    t1 = Space$(512)
    t2 = Space$(512)
    GetPrivateProfileString "Login", "Q", "", t1, 512, App.Path & "Config.ini"
    GetPrivateProfileString "Login", "P", "", t2, 512, App.Path & "Config.ini"
    t1 = Left$(t1, Len(Trim$(t1)) - 1)
    t2 = Left$(t2, Len(Trim$(t2)) - 1)
    If Len(t1) > 0 And Len(t2) > 0 Then
        qqtemp = t1
        If InStr(t1, "，") > 0 Then
            q = Split(t1, "，")
            p = Split(t2, "，")
            sum = UBound(q())
            If sum > 50 Then sum = 50
            qqsum = sum
            For i = 0 To sum
                tqq(i) = q(i)
                tmm(i) = p(i)
                Combo1.AddItem q(i)
            Next i
        Else
            qqsum = 0
            tqq(0) = t1
            tmm(0) = t2
            Combo1.AddItem t1
        End If
        Combo1.ListIndex = 0
        Combo1.SetFocus
    Else
        qqsum = -1
    End If
    TTime = Space$(64)
    GetPrivateProfileString "Config", "shicha", "", TTime, 64, App.Path & "Config.ini"
    TTime = Left$(TTime, Len(Trim$(TTime)) - 1)
    If Len(TTime) > 0 Then
        inisc = TTime
    End If
    Call shuaxin
End Sub
Private Sub Timer3_Timer()
If QQLogin.Visible = False And login = True Then
   js = js + 1
   If js >= 900 Then
      js = 0
      If Farmqk = True Then
         WebBrowser1.Navigate2 "http://happyfarm.xiaoyou.qq.com/?" & Time_C, "GET", , , WebBasic
      Else
         WebBrowser1.Navigate2 "http://happyfarm.qzone.qq.com/?" & Time_C, "GET", , , WebBasic
      End If
   End If
End If
End Sub
Private Sub Timer5_Timer()
    Timer5.Enabled = False
    If login2 = True Then
        Winsock3.Close
        If cs <= 3 Then
            login_temp = ""
            Timer5.Interval = 3000      '设置超时为5秒
            Timer5.Enabled = True       '启动超时机制
            login2 = True
            cs = cs + 1
            
            Debug.Print "正在重试"
            If Proxy = 1 Then  '使用代理
                Winsock3.Close
                Winsock3.RemoteHost = Proxy_IP
                Winsock3.RemotePort = Proxy_DK
                Winsock3.Connect
            Else
                Winsock3.Close
                Winsock3.RemoteHost = "xiaoyou.qq.com"
                Winsock3.RemotePort = 80
                Winsock3.Connect
            End If
        Else
            MsgBox "登录失败,可能是QQ服务器繁忙。", 48, "失败提示"
            XPButton1.Caption = "登录"
            Call shuaxin  '刷新验证码
        End If
    ElseIf login_qq = True Then
           
        MsgBox "登录失败,可能是QQ服务器繁忙!", 48, "失败提示"
        XPButton1.Caption = "登录"
        Call shuaxin  '刷新验证码
        
        Debug.Print "登录失败,可能是QQ服务器繁忙!" & "  " & login2
    End If
End Sub
Private Sub XPButton21_Click()
    On Error Resume Next
    Dim wz As Integer
    Dim lsqq As String, lsmm As String
    Dim q() As String, p() As String
    Combo1.Text = Trim(Combo1.Text)
    If Combo1.Text = "输入QQ号码" Then
        Combo1.Text = ""
    Else
        If Combo1.ListCount > 0 Then
            For i = 0 To Combo1.ListCount - 1
                If Val(Combo1.Text) = tqq(i) Then
                    tqq(i) = ""
                    tmm(i) = ""
                End If
                lsqq = lsqq & "，" & tqq(i)
                lsmm = lsmm & "，" & tmm(i)
            Next i
            lsqq = Replace(lsqq, "，，，", "，")
            lsmm = Replace(lsmm, "，，，", "，")
            lsqq = Replace(lsqq, "，，", "，")
            lsmm = Replace(lsmm, "，，", "，")
            If Right(lsqq, 1) = "，" Then lsqq = Mid(lsqq, 1, Len(lsqq) - 1)
            If Right(lsmm, 1) = "，" Then lsmm = Mid(lsmm, 1, Len(lsmm) - 1)
            If Left(lsqq, 1) = "，" Then lsqq = Mid(lsqq, 2, Len(lsqq))
            If Left(lsmm, 1) = "，" Then lsmm = Mid(lsmm, 2, Len(lsmm))
            WritePrivateProfileString "Login", "Q", lsqq, App.Path & "Config.ini"
            WritePrivateProfileString "Login", "P", lsmm, App.Path & "Config.ini"
            Combo1.Clear
            If Len(lsqq) > 0 And Len(lsmm) > 0 Then
                If InStr(lsqq, "，") > 0 Then
                    q = Split(lsqq, "，")
                    p = Split(lsmm, "，")
                    sum = UBound(q())
                    If sum > 50 Then sum = 50
                    qqsum = sum
                    For i = 0 To sum
                        tqq(i) = q(i)
                        tmm(i) = p(i)
                        Combo1.AddItem q(i)
                    Next i
                Else
                    qqsum = 0
                    tqq(0) = lsqq
                    tmm(0) = lsmm
                    Combo1.AddItem lsqq
                End If
                Combo1.ListIndex = 0
                Combo1.SetFocus
            Else
                qqsum = -1
                Text2.Text = ""
            End If
        Else
            Combo1.Clear
            Text2.Text = ""
        End If
    End If
    If Combo1.ListCount = 0 Then qqsum = -1
End Sub
Private Sub Form_Load()
    On Error Resume Next
    Timer1.Enabled = True
    
    WebBrowser1.Navigate "about:blank"
End Sub
Private Sub Label7_Click()
    Call shuaxin  '刷新验证码
End Sub
Private Sub Picture1_Click()
    Call shuaxin  '刷新验证码
End Sub
Private Sub Text1_keypress(KeyAscii As Integer)
    If KeyAscii = 13 Then XPButton1_Click
    If KeyAscii = 27 Then Text1.Text = ""
End Sub
Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then XPButton1_Click
    If KeyAscii = 27 Then Text2.Text = ""
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then XPButton1_Click
    If KeyAscii = 27 Then Text3.Text = ""
End Sub
Private Sub Label3_Click()
    Call shuaxin  '刷新验证码
End Sub
Private Sub shuaxin()
    On Error Resume Next
    '初始相关数据
    Text3.Text = ""
    DownGifSize = 0
    GifSize = 0
    Label3.Caption = "加载中..."
    Dim tem As String
    tem = "0" & Rnd * 1 & Int(Rnd * 50000000 + 1)
    Downloader1.BeginDownload "http://ptlogin2.qq.com/getimage?aid=15000102&" & tem, Main.SysPath & "yzm"
    Timer2.Interval = 3000      '设置超时为5秒
    Timer2.Enabled = True
End Sub
Private Sub Timer2_Timer()   '防止超时
    Timer2.Enabled = False
    Picture1.Visible = False
    Label3.Caption = "验证码获取失败！"
    Debug.Print "验证码重新获取": Call shuaxin: Exit Sub
End Sub
Private Sub Downloader1_DownloadAllComplete(FileNotDownload() As String)
    On Error Resume Next
    If UBound(FileNotDownload) > 0 Or Testdown = True Then
        Label3.Caption = "获取验证码失败!"
        Label3.Enabled = True
        Call shuaxin
    Else
    
        Label3.Visible = False
        Timer2.Enabled = False
        Picture1.Picture = LoadPicture("")
        Picture1.Picture = LoadPicture(Main.SysPath & "yzm")
        If Picture1.Picture = 0 Then Debug.Print "验证码重新获取": Call shuaxin: Exit Sub
        Picture1.Visible = True
        If Combo1.Text <> "" Then Text3.SetFocus
    End If
End Sub
'登录
Private Sub XPButton1_Click()
    On Error Resume Next
    Dim login_temp As String, tem1, tem2 As String
    Dim qqi, qq_key As String, p As String
    Dim a1 As String, a2 As String, pass As String
    Dim posttem As String
    Dim host As String
    Dim BinBuff() As Byte
    Combo1.Text = Trim(Combo1.Text)
    Text2.Text = Trim(Text2.Text)
    Text3.Text = Trim(Text3.Text)
    If Len(Combo1.Text) = 0 Or Len(Text2.Text) = 0 Then MsgBox "请输入您的QQ号和密码! ", 64, "提醒": Exit Sub
    If Len(Text3.Text) = 0 Then MsgBox "请输入登录验证码 ", 64, "提醒": Exit Sub
    If FZDD(Combo1.Text) = False Then  '防止多次登录
        If XPButton1.Caption <> "登录中..." Then
            XPButton1.Caption = "登录中..."
            login_temp = ""
            Timer5.Interval = 5000      '设置超时为5秒
            Timer5.Enabled = True       '启动超时机制
            login_qq = True
            a1 = Replace(cipher(Text2.Text), """", "～")
            a2 = Replace(a1, "", "‖")
            pass = Replace(a2, "～", """")
            pass = Replace(pass, "‖", "\")
            p = jiemi(pass, Text3.Text)
            posttem = "u=" & Combo1.Text & "&p=" & p & "&verifycode=" & Text3.Text & "&aid=15000102&u1=http%3A%2F%2Fxiaoyou.qq.com%2Findex.php%3Fmod%3Dlogin&fp=&h=1&ptredirect=1&ptlang=0&from_ui=1&dumy="
            
            Inet1.Execute "http://ptlogin2.qq.com/login", "POST", posttem, Content_Type & vbCrLf & "Referer: http://xiaoyou.qq.com" & vbCrLf & User_Agent
            Do While Inet1.StillExecuting
                DoEvents
            Loop
            BinBuff = Inet1.GetChunk(0, icByteArray)
            login_temp = UTF8_Decode(BinBuff)
            
            If InStr(login_temp, "<title>腾讯登录页面</title>") > 0 Then
                If InStr(login_temp, "密码有误") > 0 Or InStr(login_temp, "错误的次数过多") > 0 Then
                    MsgBox "您输入的密码错误,请重新输入!  ", 48, "提示"
                ElseIf InStr(login_temp, "验证码有误") > 0 Then
                    MsgBox "您输入的验证码有误,请重试!  ", 48, "提示"
                Else
                    MsgBox "登录失败，请重新尝试!  ", 48, "提示"
                End If
                
                XPButton1.Caption = "登录"
                Call shuaxin  '刷新验证码
                Timer5.Enabled = False      '关闭超时机制
            Else
'                XPButton1.Caption = "登录"
'                Call shuaxin  '刷新验证码
'                Exit Sub
                If InStr(login_temp, "jihuo.qq.com") > 0 Then
                    jh = MsgBox("您输入的QQ需要激活才能使用,请确认是否要激活?", 1, "提示")
    
                    If jh = 1 Then
                        Call gotoqqjh
                    End If
                    XPButton1.Caption = "登录"
                    Call shuaxin  '刷新验证码
                    login_temp = ""
                ElseIf InStr(login_temp, "top.location.href='http://xiaoyou.qq.com") > 0 Then
                    FarmCookies = ""
                    WebBrowser1.Navigate2 "http://xiaoyou.qq.com/favicon.ico?" & Time_C, "GET", , , WebBasic
'                    XPButton1.Caption = "登录"
                    Debug.Print "登录成功!"
                End If
            End If
        End If
    End If
End Sub
Private Sub WebBrowser1_DownloadComplete()
    On Error Resume Next
    Dim webcookies As String
    Dim loading As Boolean
    Dim temp As String
    WebBrowser1.Silent = True
    SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1&
    webtemp = webtemp & WebBrowser1.Document.body.innertext
    webcookies = WebBrowser1.Document.cookie
    
    If InStr(webcookies, "skey=") > 0 Then
       If Len(FarmCookies) = 0 Then
          loading = True
       End If
       FarmCookies = webcookies  '记录cookies
       If loading = True Then
            Timer5.Enabled = False
            login_temp = ""
            Timer5.Interval = 5000      '设置超时为5秒
            Timer5.Enabled = True       '启动超时机制
            login2 = True
            Debug.Print "开始登录校友"
            
            temp = Space$(32)
            GetPrivateProfileString Combo1.Text, "Farmlx", "", temp, 64, App.Path & "Config.ini"
            Farmlx = Val(Left$(temp, Len(Trim$(temp)) - 1))
            
            If Farmlx <> 2 Then
                If Proxy = 1 Then  '使用代理
                    Winsock3.Close
                    Winsock3.RemoteHost = Proxy_IP
                    Winsock3.RemotePort = Proxy_DK
                    Winsock3.Connect
                Else
                    Winsock3.Close
                    Winsock3.RemoteHost = "xiaoyou.qq.com"
                    Winsock3.RemotePort = 80
                    Winsock3.Connect
                End If
            Else
                Timer5.Enabled = False
                Farmqk = True
                Call wclogin  '完成登录
            End If
       End If
    End If
End Sub
Private Sub Winsock3_Connect()
    On Error Resume Next
    Dim strCommand As String
    Dim proxytemp As String
    
'    Debug.Print Now
    If Proxy = 1 Then  '使用代理
        proxytemp = "http://xiaoyou.qq.com"
    End If
    strCommand = "GET " & proxytemp & "/index.php?mod=home HTTP/1.1" & vbCrLf
    strCommand = strCommand + "Accept: */*" + vbCrLf
    strCommand = strCommand + "Accept-Language: zh-cn" + vbCrLf
'    strCommand = strCommand + "Accept-Encoding: gzip, deflate" + vbCrLf
    If Proxy = 1 And Len(Basic) > 0 Then strCommand = strCommand & "Proxy-Authorization: Basic " & Basic & vbCrLf
    strCommand = strCommand & "Host: xiaoyou.qq.com" & vbCrLf
    strCommand = strCommand & "Connection: close" & vbCrLf
    strCommand = strCommand & "Referer: http://ptlogin2.qq.com/" & vbCrLf
    strCommand = strCommand & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1;)" & vbCrLf
    strCommand = strCommand & "Cookie: " & FarmCookies & vbCrLf
'    strCommand = strCommand & "Cookie: pt2gguin=" & login_uid & "; uin=" & login_uid & "; skey=" & login_skey & "; ptcz=" & login_ptcz & "; pvid=" & login_pvid & ";" & vbCrLf
    strCommand = strCommand & vbCrLf
    Winsock3.SendData strCommand
    
    
End Sub
Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    ReDim str(bytesTotal - 1) As Byte
    Winsock3.GetData str, vbArray + vbByte
    login_temp = login_temp & UTF8_Decode(str)
    If InStr(login_temp, "icon_app_manage") > 0 Then
        Call Winsock3_Close
    End If
    
'    Debug.Print Now
End Sub
Private Sub Winsock3_Close()
    On Error Resume Next
    Winsock3.Close
    Dim sz As String
    If Len(login_temp) > 0 Then
        Winsock3.Close
        login2 = False
        Timer5.Enabled = False
        
        If InStr(login_temp, "pst=") > 0 Then
            Dim pst_temp As Long
            pst_temp = split_m(4, login_temp, "pst")
            If pst_temp > 0 Then pst = pst_temp
            pst_temp = DateDiff("s", DateSerial(1970, 1, 1), Now()) - pst_temp
            If pst_temp > 0 Then shicha = pst_temp
            Call shichaini(shicha)  '更新时差
        End If
        If InStr(login_temp, "icon_app_manage") > 0 Then
            If InStr(login_temp, ">ＱＱ农场</a>") > 0 Then
               Farmqk = True
               sz = "2"
            Else
               Farmqk = False
               sz = "1"
            End If
            Call wclogin  '完成登录
            
            WritePrivateProfileString Combo1.Text, "Farmlx", sz, App.Path & "Config.ini"
            
        ElseIf InStr(login_temp, "location: /index.html?ref=http") > 0 Then
            MsgBox "登录失败,可能是QQ服务器繁忙!", 48, "失败提示"
            XPButton1.Caption = "登录"
            Call shuaxin  '刷新验证码
        ElseIf InStr(login_temp, "出错啦，您还没有注册，") > 0 Or InStr(login_temp, "location: /index.php?mod=") > 0 Then
            Farmqk = False
            login_temp = ""
            Timer5.Interval = 5000      '设置超时为5秒
            Timer5.Enabled = True       '启动超时机制
            login2 = True
            If Proxy = 1 Then  '使用代理
                Winsock4.Close
                Winsock4.RemoteHost = Proxy_IP
                Winsock4.RemotePort = Proxy_DK
                Winsock4.Connect
            Else
                Winsock4.Close
                Winsock4.RemoteHost = "happyfarm.qzone.qq.com"
                Winsock4.RemotePort = 80
                Winsock4.Connect
            End If
            Exit Sub
        Else
            MsgBox "登录失败,可能是QQ服务器繁忙!!", 48, "失败提示"
            XPButton1.Caption = "登录"
            Call shuaxin  '刷新验证码
        End If
        login_temp = ""
    End If
End Sub
Private Sub Winsock4_Connect()
    On Error Resume Next
    Dim strCommand As String
    Dim proxytemp As String
    If Proxy = 1 Then  '使用代理
        proxytemp = "http://happyfarm.qzone.qq.com/"
    End If
    strCommand = "GET " & proxytemp & "/ HTTP/1.1" & vbCrLf
    strCommand = strCommand + "Accept: */*" + vbCrLf
    strCommand = strCommand + "Accept-Language: zh-cn" + vbCrLf
    strCommand = strCommand + "Accept-Encoding: gzip, deflate" + vbCrLf
    If Proxy = 1 And Len(Basic) > 0 Then strCommand = strCommand & "Proxy-Authorization: Basic " & Basic & vbCrLf
    strCommand = strCommand & "Host: happyfarm.qzone.qq.com" & vbCrLf
    strCommand = strCommand & "Connection: close" & vbCrLf
    strCommand = strCommand & "Referer: http://qzone.qq.com/" & vbCrLf
    strCommand = strCommand & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1;)" & vbCrLf
    strCommand = strCommand & "Cookie: " & FarmCookies & vbCrLf
'    strCommand = strCommand & "Cookie: uin=" & login_uid & "; skey=" & login_skey & ";" & vbCrLf
    strCommand = strCommand & vbCrLf
    Winsock4.SendData strCommand
    
End Sub
Private Sub Winsock4_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    ReDim str(bytesTotal - 1) As Byte
    Winsock4.GetData str, vbArray + vbByte
    login_temp = login_temp & UTF8_Decode(str)
    If InStr(login_temp, "<!--==E 模框内容-->") > 0 Then
        Call Winsock4_Close
    End If
End Sub
Private Sub Winsock4_Close()
    On Error Resume Next
    Winsock4.Close
    Dim sz As String
    If Len(login_temp) > 0 Then
        Winsock4.Close
        login2 = False
        Timer5.Enabled = False
        If InStr(login_temp, "<!--==E 模框内容-->") > 0 Then
            If InStr(login_temp, "pst=") > 0 Then
                Dim pst_temp As Long
                pst_temp = split_m(4, login_temp, "pst")
                If pst_temp > 0 Then pst = pst_temp
                pst_temp = DateDiff("s", DateSerial(1970, 1, 1), Now()) - pst_temp
                If pst_temp > 0 Then shicha = pst_temp
                Call shichaini(shicha)  '更新时差
            End If
            If InStr(login_temp, "请下载最新的Flash插件") > 0 Then
               Farmqk = False
               Call wclogin  '完成登录
               sz = "1"
               WritePrivateProfileString Combo1.Text, "Farmlx", sz, App.Path & "Config.ini"
            ElseIf InStr(login_temp, "和好友一起开开心心当农场主") > 0 Then
               MsgBox "对不起，您的QQ还没开通开心农场!!", 48, "失败提示"
               XPButton1.Caption = "登录"
               Call shuaxin  '刷新验证码
            End If
        Else
            MsgBox "登录失败,可能是QQ服务器繁忙!!", 48, "失败提示"
            XPButton1.Caption = "登录"
            Call shuaxin  '刷新验证码
        End If
        login_temp = ""
    End If
End Sub
Sub wclogin()  '完成登录
    On Error Resume Next
    Dim lsqq As String, lsmm As String
    Dim jlqq As String, jlmm As String
    Randomize Timer
'    login_pvid = Int(Rnd * 90000 + 10000) & Int(Rnd * 90000 + 10000)
    If Check1.value = 1 Then  '自动保存QQ
        lsqq = Val(Combo1.Text)
        lsmm = decipher(Text2.Text)
        If qqsum >= 0 Then
            For K = 0 To qqsum
                If tqq(K) = Val(Combo1.Text) Then
                    lsqq = tqq(K)
                    lsmm = decipher(Text2.Text)
                    tqq(K) = ""
                    tmm(K) = ""
                    Exit For
                End If
            Next K
            For i = 0 To qqsum
                lsqq = lsqq & "，" & tqq(i)
                lsmm = lsmm & "，" & tmm(i)
            Next i
        End If
        lsqq = Replace(lsqq, "，，，", "，")
        lsmm = Replace(lsmm, "，，，", "，")
        lsqq = Replace(lsqq, "，，", "，")
        lsmm = Replace(lsmm, "，，", "，")
        If Right(lsqq, 1) = "，" Then lsqq = Mid(lsqq, 1, Len(lsqq) - 1)
        If Right(lsmm, 1) = "，" Then lsmm = Mid(lsmm, 1, Len(lsmm) - 1)
        WritePrivateProfileString "Login", "Q", lsqq, App.Path & "Config.ini"
        WritePrivateProfileString "Login", "P", lsmm, App.Path & "Config.ini"
    End If
    
    MyQQ = Combo1.Text
    
    QQLogin.Visible = False
    Form1.Timer1.Enabled = False
    Form1.Timer1.Interval = 10
    Form1.Timer1.Enabled = True
    
    login = True   '记录已经登录
    
    Myuid = 0
    cs = 0
    If pst = 0 Then
       If inisc > 0 Then
          shicha = inisc
          pst = DateDiff("s", DateSerial(1970, 1, 1), Now()) - shicha
       Else
          pst = DateDiff("s", DateSerial(1970, 1, 1), Now()) - 28800
          shicha = Time_C - pst
       End If
    End If
    
    XPButton1.Caption = "登录"
    Form1.Timer13.Enabled = True
    Form1.Timer8.Enabled = True
    Form1.Label26.Caption = MyQQ
    Form1.Label26.Visible = True
    Form1.Label27.Visible = False
    Form1.denglu.Caption = "重新登录(&L)"
    Form1.XPButton21.Caption = "停止工作"
    Form1.XPButton21.ForeColor = &H8000&
    Call jzini(MyQQ)
    Form1.bbi = 300   '背包
    Form1.keygxi = 3600
    Form1.Timer5.Enabled = False: Form1.Timer5.Enabled = True
    Form1.Timer3.Interval = 100: Form1.Timer3.Enabled = False: Form1.Timer3.Enabled = True
    login_time = Time_C
    Main.Caption = "Mainload|" & MyQQ & "|"
    Call jilu("系统", MyQQ, "登录成功(QQ:" & MyQQ & ")，当前软件版本：V" & Form1.bbid & " " & Form1.bbname)
    If fqgg = 0 Then
        Call jilu("系统", MyQQ, "温馨提醒：您还没有开启自动“识别狗狗”,可以打开“设置”开启。")
    Else
        Call jilu("系统", MyQQ, "温馨提醒：您已打开自动“识别狗狗”,有狗粮的农场将不自动偷取。")
    End If
    If zdbz = 0 Then Call jilu("系统", MyQQ, "温馨提醒：您还没有打开“自动播种”,请打开“设置”开启。")
    TrayTip Form1, "登录用户：" & MyQQ & vbCrLf & "-----------------------------" & vbCrLf & "欢迎使用《QQ伴侣》by:天堂" & vbCrLf & "使用交流：http://www.h876.com"
    
    js = 898
    
    login_temp = ""
    If Proxy = 1 Then  '使用代理
        Winsock2.Close
        Winsock2.RemoteHost = Proxy_IP
        Winsock2.RemotePort = Proxy_DK
        Winsock2.Connect
    Else
        Winsock2.Close
        Winsock2.RemoteHost = "xiaoyou.qq.com"
        Winsock2.RemotePort = 80
        Winsock2.Connect
    End If
'    Unload QQLogin
End Sub
Private Sub jzini(qq)
    On Error Resume Next
    Dim sz As String
    Dim T As String, t1 As String, t2 As String, gxTemp_temp As String, BmCs_temp As String
    Dim szini() As String
    Dim szini1() As String
    Dim temp As String
    Dim sum As Integer
    
    Dim SmTime_temp As String
    Dim csi_temp As String
    Dim yzmts_temp As String              '验证码提示方式
    Dim shengyin_temp As String           '提示声音文件
    
    
    T = Space$(64)
    t1 = Space$(64)
    t2 = Space$(32)
    GetPrivateProfileString qq, "szini", "", T, 64, App.Path & "Config.ini"
    szini = Split(Left$(T, Len(Trim$(T)) - 1), ",")
    sum = UBound(szini()) + 1
    If sum = 12 Then
        zdsg = Val(szini(0))            '是否自动收割
        zdsc = Val(szini(1))            '是否自动杀虫
        zdcc = Val(szini(2))            '是否自动锄草
        zdjs = Val(szini(3))             '是否自动浇水
        zdbz = Val(szini(4))           '是否自动播种
        zdtq = Val(szini(5))            '是否自动收割
        zdbsc = Val(szini(6))           '是否自动杀虫
        zdbcc = Val(szini(7))           '是否自动锄草
        zdbjs = Val(szini(8))           '是否自动浇水
        xzbz = Val(szini(9))            '是否限制满150次帮助自动停止帮忙
        bzzl = Val(szini(10))           '播种作物种类
        bzid = Split(kind(bzzl + 1), ",")(1) '作物ID
        fqgg = Val(szini(11))            '是否放弃狗狗
    Else
        zdsg = 1           '是否自动收割
        zdsc = 1           '是否自动杀虫
        zdcc = 1           '是否自动锄草
        zdjs = 1           '是否自动浇水
        zdbz = 0           '是否自动播种
        zdtq = 1            '是否自动偷取
        zdbsc = 1           '是否帮好友自动杀虫
        zdbcc = 1          '是否自动帮好友锄草
        zdbjs = 1           '是否帮好友自动浇水
        xzbz = 1            '是否限制满150次帮助自动停止帮忙
        bzzl = 0            '播种作物种类
        bzid = 2            '作物ID
        fqgg = 1            '是否放弃狗狗
        
        sz = zdsg & "," & zdsc & "," & zdcc & "," & zdjs & "," & zdbz & "," & zdtq & "," & zdbsc & "," & zdbcc & "," & zdbjs & "," & xzbz & "," & bzzl & "," & fqgg
        WritePrivateProfileString qq, "szini", sz, App.Path & "Config.ini"
'        Debug.Print "保存设置成功!"
    End If
    GetPrivateProfileString qq, "szini1", "", t1, 64, App.Path & "Config.ini"
    szini1 = Split(Left$(t1, Len(Trim$(t1)) - 1), ",")
    sum = UBound(szini1()) + 1
    If sum = 13 Then
        blpl = Val(szini1(0))               '扫描每个好友农场的频率
        blxx = Val(szini1(1))               '搜索每轮好友后自动休息
        mypl = Val(szini1(2))               '自己的农场操作时间间隔
        hypl = Val(szini1(3))               '好友的农场操作时间间隔
        mysx = Val(szini1(4))               '刷新自己农场的时间间隔
        lbsx = Val(szini1(5))               '更新好友列表的时间间隔
        xzsj = Val(szini1(6))               '农场被临时限制自动休息
        zdxx = Val(szini1(7))               '是否自动休息
        gzsj = Val(szini1(8))               '工作时间
        xxsj = Val(szini1(9))               '休息时间
        smxx = Val(szini1(10))              '扫描休息
        smrs = Val(szini1(11))              '扫描人数
        smxxsj = Val(szini1(12))            '扫描休息时间
    
    
        If blpl >= 60000 Then blpl = 60000
        If mypl >= 60000 Then mypl = 60000
        If hypl >= 60000 Then hypl = 60000
        
        If blpl < 500 Then blpl = 500
        If mypl < 500 Then mypl = 500
        If hypl < 500 Then hypl = 500
        If mysx < 15 Then mysx = 15
        
        Form1.Timer5.Interval = blpl    '扫描每个好友农场的频率
        Form1.Timer19.Interval = mypl   '自己的农场操作时间间隔
        Form1.Timer6.Interval = hypl    '好友的农场操作时间间隔
    Else
        blpl = 1000               '扫描每个好友农场的频率
        blxx = 180                '搜索每轮好友后自动休息
        mypl = 1000               '自己的农场操作时间间隔
        hypl = 1000               '好友的农场操作时间间隔
        mysx = 300                '刷新自己农场的时间间隔
        lbsx = 8                  '更新好友列表的时间间隔
        xzsj = 15                 '农场被临时限制自动休息
        zdxx = 0                  '是否自动休息
        gzsj = 30                 '工作时间
        xxsj = 15                 '休息时间
        smxx = 0                '扫描休息
        smrs = 100              '扫描人数
        smxxsj = 30             '扫描休息时间
        
        Form1.Timer5.Interval = blpl    '扫描每个好友农场的频率
        Form1.Timer19.Interval = mypl   '自己的农场操作时间间隔
        Form1.Timer6.Interval = hypl    '好友的农场操作时间间隔
    
        sz = blpl & "," & blxx & "," & mypl & "," & hypl & "," & mysx & "," & lbsx & "," & xzsj & "," & zdxx & "," & gzsj & "," & xxsj & "," & smxx & "," & smrs & "," & smxxsj
        WritePrivateProfileString qq, "szini1", sz, App.Path & "Config.ini"
'        Debug.Print "保存设置成功1!"
    End If
    
    
    '获取上次保存时间
    gxTemp_temp = Space$(32)
    GetPrivateProfileString qq, "BmTime", "", gxTemp_temp, 32, App.Path & "Config.ini"
    gxTemp_temp = Left$(gxTemp_temp, Len(Trim$(gxTemp_temp)) - 1)
    If Len(gxTemp_temp) = 10 Then
       Form1.gxTime = Val(gxTemp_temp)
    End If
    
    
    '获取上次帮忙次数
    BmCs_temp = Space$(32)
    GetPrivateProfileString qq, "BmCs", "", BmCs_temp, 32, App.Path & "Config.ini"
    BmCs_temp = Left$(BmCs_temp, Len(Trim$(BmCs_temp)) - 1)
    If Val(BmCs_temp) > 0 Then
       Form1.Label45.Caption = Val(BmCs_temp)
    End If
    
    
    SmTime_temp = Space$(32)
    csi_temp = Space$(32)
    GetPrivateProfileString qq, "SmTime", "", SmTime_temp, 32, App.Path & "Config.ini"
    GetPrivateProfileString qq, "csi", "", csi_temp, 32, App.Path & "Config.ini"
    SmTime_temp = Left$(SmTime_temp, Len(Trim$(SmTime_temp)) - 1)
    csi_temp = Left$(csi_temp, Len(Trim$(csi_temp)) - 1)
    
    If Len(SmTime_temp) = 10 Then
       SmTime = Val(SmTime_temp)
       If Val(csi_temp) > 0 And Time_C - SmTime < blxx * 45 Then
          csi = Val(csi_temp)
          Smjixu = True
       End If
    End If
    
    yzmts_temp = Space$(32)           '验证码提示方式
    shengyin_temp = Space$(32)        '提示声音文件
    GetPrivateProfileString qq, "yzmts", "", yzmts_temp, 32, App.Path & "Config.ini"
    GetPrivateProfileString qq, "shengyin", "", shengyin_temp, 32, App.Path & "Config.ini"
    yzmts = Val(Left$(yzmts_temp, Len(Trim$(yzmts_temp)) - 1))
    shengyin = Left$(shengyin_temp, Len(Trim$(shengyin_temp)) - 1)
    
    If Len(shengyin) = 0 Or Dir(App.Path & "sound" & shengyin) = "" Then
       Form1.File1.Refresh
       If Form1.File1.ListCount > 0 Then
          For i = 0 To Form1.File1.ListCount - 1
              If InStr(LCase(Form1.File1.List(i)), ".wav") > 0 And FileLen(App.Path & "sound" & File1.List(i)) < 1001024 Then
                 shengyin = Form1.File1.List(i)
                 WritePrivateProfileString qq, "shengyin", shengyin, App.Path & "Config.ini"
                 Exit For
              End If
          Next i
       Else
          shengyin = "音频1.wav"
       End If
    End If
End Sub
Private Sub XPButton2_Click()  '退出
    Unload QQLogin
End Sub
Public Function jiemi(p As String, y As String) As String
    On Error Resume Next
    Dim a1 As String, a2 As String, a3 As String, a4 As String, a5 As String
    Dim a6 As String, a7 As String, a8 As String, a9 As String, a10 As String
    'WebBrowser1.Document.writeln ""
    a6 = "    c = md5_hh(c, d, a, b, x[i + 15], 16, 530742520);" & vbCrLf _
    & "    b = md5_hh(b, c, d, a, x[i + 2], 23,  - 995338651);" & vbCrLf _
    & "    a = md5_ii(a, b, c, d, x[i + 0], 6,  - 198630844);" & vbCrLf _
    & "    d = md5_ii(d, a, b, c, x[i + 7], 10, 1126891415);" & vbCrLf _
    & "    c = md5_ii(c, d, a, b, x[i + 14], 15,  - 1416354905);" & vbCrLf _
    & "    b = md5_ii(b, c, d, a, x[i + 5], 21,  - 57434055);" & vbCrLf _
    & "    a = md5_ii(a, b, c, d, x[i + 12], 6, 1700485571);" & vbCrLf _
    & "    d = md5_ii(d, a, b, c, x[i + 3], 10,  - 1894986606);" & vbCrLf _
    & "    c = md5_ii(c, d, a, b, x[i + 10], 15,  - 1051523);" & vbCrLf _
    & "    b = md5_ii(b, c, d, a, x[i + 1], 21,  - 2054922799);" & vbCrLf _
    & "    a = md5_ii(a, b, c, d, x[i + 8], 6, 1873313359);" & vbCrLf _
    & "    d = md5_ii(d, a, b, c, x[i + 15], 10,  - 30611744);" & vbCrLf _
    & "    c = md5_ii(c, d, a, b, x[i + 6], 15,  - 1560198380);" & vbCrLf _
    & "    b = md5_ii(b, c, d, a, x[i + 13], 21, 1309151649);" & vbCrLf _
    & "    a = md5_ii(a, b, c, d, x[i + 4], 6,  - 145523070);" & vbCrLf _
    & "    d = md5_ii(d, a, b, c, x[i + 11], 10,  - 1120210379);" & vbCrLf _
    & "    c = md5_ii(c, d, a, b, x[i + 2], 15, 718787259);" & vbCrLf _
    & "    b = md5_ii(b, c, d, a, x[i + 9], 21,  - 343485551);" & vbCrLf
    a2 = "function md5(s)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return hex_md5(s);" & vbCrLf _
    & "}" & vbCrLf _
    & "function hex_md5(s)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return binl2hex(core_md5(str2binl(s), s.length * chrsz));" & vbCrLf _
    & "}" & vbCrLf _
    & "function core_md5(x, len)" & vbCrLf _
    & "{" & vbCrLf _
    & "  x[len >> 5] |= 128 << (len % 32);" & vbCrLf _
    & "  x[(((len + 64) >>> 9) << 4) + 14] = len; " & vbCrLf _
    & "  var a = 1732584193;" & vbCrLf _
    & "  var b =  - 271733879;" & vbCrLf _
    & "  var c =  - 1732584194;" & vbCrLf _
    & "  var d = 271733878;" & vbCrLf _
    & "  for (var i = 0; i < x.length; i=16)" & vbCrLf
    a4 = "    c = md5_ff(c, d, a, b, x[i + 14], 17,  - 1502002290);" & vbCrLf _
    & "    b = md5_ff(b, c, d, a, x[i + 15], 22, 1236535329);" & vbCrLf _
    & "    a = md5_gg(a, b, c, d, x[i + 1], 5,  - 165796510);" & vbCrLf _
    & "    d = md5_gg(d, a, b, c, x[i + 6], 9,  - 1069501632);" & vbCrLf _
    & "    c = md5_gg(c, d, a, b, x[i + 11], 14, 643717713);" & vbCrLf _
    & "    b = md5_gg(b, c, d, a, x[i + 0], 20,  - 373897302);" & vbCrLf _
    & "    a = md5_gg(a, b, c, d, x[i + 5], 5,  - 701558691);" & vbCrLf _
    & "    d = md5_gg(d, a, b, c, x[i + 10], 9, 38016083);" & vbCrLf _
    & "    c = md5_gg(c, d, a, b, x[i + 15], 14,  - 660478335);" & vbCrLf _
    & "    b = md5_gg(b, c, d, a, x[i + 4], 20,  - 405537848);" & vbCrLf _
    & "    a = md5_gg(a, b, c, d, x[i + 9], 5, 568446438);" & vbCrLf _
    & "    d = md5_gg(d, a, b, c, x[i + 14], 9,  - 1019803690);" & vbCrLf _
    & "    c = md5_gg(c, d, a, b, x[i + 3], 14,  - 187363961);" & vbCrLf _
    & "    b = md5_gg(b, c, d, a, x[i + 8], 20, 1163531501);" & vbCrLf _
    & "    a = md5_gg(a, b, c, d, x[i + 13], 5,  - 1444681467);" & vbCrLf _
    & "    d = md5_gg(d, a, b, c, x[i + 2], 9,  - 51403784);" & vbCrLf _
    & "    c = md5_gg(c, d, a, b, x[i + 7], 14, 1735328473);" & vbCrLf _
    & "    b = md5_gg(b, c, d, a, x[i + 12], 20,  - 1926607734);" & vbCrLf
    a8 = "}" & vbCrLf _
    & "function md5_ff(a, b, c, d, x, s, t)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return md5_cmn((b & c) | ((~b) & d), a, b, x, s, t);" & vbCrLf _
    & "}" & vbCrLf _
    & "function md5_gg(a, b, c, d, x, s, t)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return md5_cmn((b & d) | (c & (~d)), a, b, x, s, t);" & vbCrLf _
    & "}" & vbCrLf _
    & "function md5_hh(a, b, c, d, x, s, t)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return md5_cmn(b ^ c ^ d, a, b, x, s, t);" & vbCrLf _
    & "}" & vbCrLf _
    & "function md5_ii(a, b, c, d, x, s, t)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return md5_cmn(c ^ (b | (~d)), a, b, x, s, t);" & vbCrLf _
    & "}" & vbCrLf
    a3 = "  {" & vbCrLf _
    & "    var olda = a;" & vbCrLf _
    & "    var oldb = b;" & vbCrLf _
    & "    var oldc = c;" & vbCrLf _
    & "    var oldd = d;" & vbCrLf _
    & "    a = md5_ff(a, b, c, d, x[i + 0], 7,  - 680876936);" & vbCrLf _
    & "    d = md5_ff(d, a, b, c, x[i + 1], 12,  - 389564586);" & vbCrLf _
    & "    c = md5_ff(c, d, a, b, x[i + 2], 17, 606105819);" & vbCrLf _
    & "    b = md5_ff(b, c, d, a, x[i + 3], 22,  - 1044525330);" & vbCrLf _
    & "    a = md5_ff(a, b, c, d, x[i + 4], 7,  - 176418897);" & vbCrLf _
    & "    d = md5_ff(d, a, b, c, x[i + 5], 12, 1200080426);" & vbCrLf _
    & "    c = md5_ff(c, d, a, b, x[i + 6], 17,  - 1473231341);" & vbCrLf _
    & "    b = md5_ff(b, c, d, a, x[i + 7], 22,  - 45705983);" & vbCrLf _
    & "    a = md5_ff(a, b, c, d, x[i + 8], 7, 1770035416);" & vbCrLf _
    & "    d = md5_ff(d, a, b, c, x[i + 9], 12,  - 1958414417);" & vbCrLf _
    & "    c = md5_ff(c, d, a, b, x[i + 10], 17,  - 42063);" & vbCrLf _
    & "    b = md5_ff(b, c, d, a, x[i + 11], 22,  - 1990404162);" & vbCrLf _
    & "    a = md5_ff(a, b, c, d, x[i + 12], 7, 1804603682);" & vbCrLf _
    & "    d = md5_ff(d, a, b, c, x[i + 13], 12,  - 40341101);" & vbCrLf
    a7 = "    a = safe_add(a, olda);" & vbCrLf _
    & "    b = safe_add(b, oldb);" & vbCrLf _
    & "    c = safe_add(c, oldc);" & vbCrLf _
    & "    d = safe_add(d, oldd);" & vbCrLf _
    & "  }" & vbCrLf _
    & "  if (mode == 16)" & vbCrLf _
    & "  {" & vbCrLf _
    & "    return Array(b, c);" & vbCrLf _
    & "  }" & vbCrLf _
    & "  else" & vbCrLf _
    & "  {" & vbCrLf _
    & "    return Array(a, b, c, d);" & vbCrLf _
    & "  }" & vbCrLf _
    & "}" & vbCrLf _
    & "function md5_cmn(q, a, b, x, s, t)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return safe_add(bit_rol(safe_add(safe_add(a, q), safe_add(x, t)), s), b);" & vbCrLf
    a5 = "    a = md5_hh(a, b, c, d, x[i + 5], 4,  - 378558);" & vbCrLf _
    & "    d = md5_hh(d, a, b, c, x[i + 8], 11,  - 2022574463);" & vbCrLf _
    & "    c = md5_hh(c, d, a, b, x[i + 11], 16, 1839030562);" & vbCrLf _
    & "    b = md5_hh(b, c, d, a, x[i + 14], 23,  - 35309556);" & vbCrLf _
    & "    a = md5_hh(a, b, c, d, x[i + 1], 4,  - 1530992060);" & vbCrLf _
    & "    d = md5_hh(d, a, b, c, x[i + 4], 11, 1272893353);" & vbCrLf _
    & "    c = md5_hh(c, d, a, b, x[i + 7], 16,  - 155497632);" & vbCrLf _
    & "    b = md5_hh(b, c, d, a, x[i + 10], 23,  - 1094730640);" & vbCrLf _
    & "    a = md5_hh(a, b, c, d, x[i + 13], 4, 681279174);" & vbCrLf _
    & "    d = md5_hh(d, a, b, c, x[i + 0], 11,  - 358537222);" & vbCrLf _
    & "    c = md5_hh(c, d, a, b, x[i + 3], 16,  - 722521979);" & vbCrLf _
    & "    b = md5_hh(b, c, d, a, x[i + 6], 23, 76029189);" & vbCrLf _
    & "    a = md5_hh(a, b, c, d, x[i + 9], 4,  - 640364487);" & vbCrLf _
    & "    d = md5_hh(d, a, b, c, x[i + 12], 11,  - 421815835);" & vbCrLf
    a9 = "" & vbCrLf _
    & "function safe_add(x, y)" & vbCrLf _
    & "{" & vbCrLf _
    & "  var lsw = (x & 0xFFFF) + (y & 0xFFFF);" & vbCrLf _
    & "  var msw = (x >> 16) + (y >> 16) + (lsw >> 16);" & vbCrLf _
    & "  return (msw << 16) | (lsw & 0xFFFF);" & vbCrLf _
    & "}" & vbCrLf _
    & "function bit_rol(num, cnt)" & vbCrLf _
    & "{" & vbCrLf _
    & "  return (num << cnt) | (num  >>> (32-cnt));" & vbCrLf _
    & "}" & vbCrLf _
    & "function str2binl(str)" & vbCrLf _
    & "{" & vbCrLf _
    & "  var bin = Array();" & vbCrLf _
    & "  var mask = (1 << chrsz) - 1;" & vbCrLf _
    & "  for (var i = 0; i < str.length * chrsz; i += chrsz)" & vbCrLf _
    & "    bin[i >> 5] |= (str.charCodeAt(i / chrsz) & mask) << (i % 32);" & vbCrLf
    a10 = "  return bin;" & vbCrLf _
    & "}" & vbCrLf _
    & "function binl2hex(binarray)" & vbCrLf _
    & "{" & vbCrLf _
    & "  var hex_tab = hexcase ? ""0123456789ABCDEF"" : ""0123456789abcdef"";" & vbCrLf _
    & "  var str = """";" & vbCrLf _
    & "  for (var i = 0; i < binarray.length * 4; i++)" & vbCrLf _
    & "  {" & vbCrLf _
    & "    str += hex_tab.charAt((binarray[i >> 2] >> ((i % 4) * 8+4)) & 0xF) +" & vbCrLf _
    & "      hex_tab.charAt((binarray[i >> 2] >> ((i % 4) * 8)) & 0xF);" & vbCrLf _
    & "  }" & vbCrLf _
    & "  return str;" & vbCrLf _
    & "}" & vbCrLf _
    & "</script>"
    a1 = "<script language=javascript>" & vbCrLf _
    & "var hexcase = 1;" & vbCrLf _
    & "var chrsz = 8;" & vbCrLf _
    & "var mode = 32;" & vbCrLf _
    & "preprocess(""" & p & """,""" & y & """)" & vbCrLf _
    & "function preprocess(ues,pp)" & vbCrLf _
    & "{" & vbCrLf _
    & "  var p = ues;" & vbCrLf _
    & "  var str = pp;" & vbCrLf _
    & "  str = str.toUpperCase();" & vbCrLf _
    & "  p = md5(md5_3(p)+str);" & vbCrLf _
    & "  document.write(p)" & vbCrLf _
    & "}" & vbCrLf _
    & "function md5_3(s)" & vbCrLf _
    & "{" & vbCrLf _
    & "  var tmp = new Array;" & vbCrLf _
    & "  tmp = core_md5(str2binl(s), s.length * chrsz);" & vbCrLf _
    & "  tmp = core_md5(tmp, 16 * chrsz);" & vbCrLf _
    & "  tmp = core_md5(tmp, 16 * chrsz);" & vbCrLf _
    & "  return binl2hex(tmp);" & vbCrLf _
    & "}" & vbCrLf
    WebBrowser1.Document.Open
    WebBrowser1.Document.writeln a1 & a2 & a3 & a4 & a5 & a6 & a7 & a8 & a9 & a10
    WebBrowser1.Document.Close
    jiemi = Trim(WebBrowser1.Document.body.innertext)
End Function

						