外挂编程

开发平台：
Visual Basic

Form7.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"
Begin VB.Form Form7 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "QQ登陆"
   ClientHeight    =   4575
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5925
   Icon            =   "Form7.frx":0000
   LinkTopic       =   "Form7"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4575
   ScaleWidth      =   5925
   StartUpPosition =   1  '所有者中心
   Begin VB.Timer Timer2 
      Interval        =   1000
      Left            =   4320
      Top             =   2520
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Left            =   3360
      Top             =   2160
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   3960
      Top             =   960
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   4320
      Top             =   3120
   End
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   4575
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5895
      ExtentX         =   10398
      ExtentY         =   8070
      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        =   "http:///"
   End
   Begin VB.Label Label1 
      Caption         =   "正在登陆中..."
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   39.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1335
      Left            =   480
      TabIndex        =   1
      Top             =   1320
      Width           =   5415
   End
End
Attribute VB_Name = "Form7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim webtemp As String
Dim login_temp As String
Dim i As Integer
Private Sub Form_Load()
webtemp = ""
WebBrowser1.Navigate2 "http://ui.ptlogin2.qq.com/cgi-bin/login?appid=15000102&hide_title_bar=1&qlogin_jumpname=xiaoyou_qlogin&s_url=http://xiaoyou.qq.com/index.php%3Fmod%3Dlogin&css=http://imgcache.qq.com/campus/login/login.css&self_regurl=http://xiaoyou.qq.com/emailreg.html", "GET", , , WebBasic
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
webtemp = ""
WebBrowser1.Top = 0
WebBrowser1.Navigate2 "http://ui.ptlogin2.qq.com/cgi-bin/login?appid=15000102&hide_title_bar=1&qlogin_jumpname=xiaoyou_qlogin&s_url=http://xiaoyou.qq.com/index.php%3Fmod%3Dlogin&css=http://imgcache.qq.com/campus/login/login.css&self_regurl=http://xiaoyou.qq.com/emailreg.html&?" & time_c, "GET", , , WebBasic
End Sub
Private Sub Timer2_Timer()
If Form7.Visible = False And login = True Then
   i = i + 1
   If i >= 900 Then
      i = 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 WebBrowser1_DownloadBegin()  '防止弹出非法错误的提示
    On Error Resume Next
    WebBrowser1.Silent = True
End Sub
Private Sub WebBrowser1_DownloadComplete()
    On Error Resume Next
    Dim webcookies 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
       FarmCookies = webcookies  '记录cookies
'       Debug.Print FarmCookies
    End If
    
    Debug.Print FarmCookies
'    If InStr(webtemp, "网站导航 | 举报") > 1 And InStr(webcookies, "skey=") > 1 And Form7.Visible = True Then
'        Farmqk = True
'        login_temp = ""
'        If Proxy = 1 Then  '使用代理
'            Winsock1.Close
'            Winsock1.RemoteHost = Proxy_IP
'            Winsock1.RemotePort = Proxy_DK
'            Winsock1.Connect
'        Else
'            Winsock1.Close
'            Winsock1.RemoteHost = "happyfarm.qzone.qq.com"
'            Winsock1.RemotePort = 80
'            Winsock1.Connect
'        End If
'        WebBrowser1.Top = 10000
'        Debug.Print "进入校友"
'    ElseIf (InStr(webtemp, "向QQ好友索要邀请") > 1 Or InStr(webtemp, "方式A") > 1 Or InStr(webtemp, "加入你的班级") > 1 Or InStr(webtemp, "以下默认已填写") > 1) And InStr(webcookies, "skey=") > 1 And Form7.Visible = True Then
'        Farmqk = False
'        login_temp = ""
'        If Proxy = 1 Then  '使用代理
'            Winsock1.Close
'            Winsock1.RemoteHost = Proxy_IP
'            Winsock1.RemotePort = Proxy_DK
'            Winsock1.Connect
'        Else
'            Winsock1.Close
'            Winsock1.RemoteHost = "happyfarm.qzone.qq.com"
'            Winsock1.RemotePort = 80
'            Winsock1.Connect
'        End If
'       WebBrowser1.Top = 10000
'       Debug.Print "进入QQ空间"
'    End If
End Sub
Private Sub Winsock1_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; SV1)" & vbCrLf
    strCommand = strCommand & "Cookie: " & FarmCookies & vbCrLf
'    strCommand = strCommand & "Cookie: uin=" & login_uid & "; skey=" & login_skey & ";" & vbCrLf
    strCommand = strCommand & vbCrLf
    Winsock1.SendData strCommand
    
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    ReDim str(bytesTotal - 1) As Byte
    Winsock1.GetData str, vbArray + vbByte
    login_temp = login_temp & UTF8_Decode(str)
    If InStr(login_temp, "<!--==E 模框内容-->") > 0 Then
        Call Winsock1_Close
    End If
End Sub
Private Sub Winsock1_Close()
    On Error Resume Next
    If Len(login_temp) > 0 Then
        Winsock1.Close
        If InStr(login_temp, "<!--==E 模框内容-->") > 0 Then
'            Debug.Print login_temp
            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
            End If
            If InStr(login_temp, "happyfarm/happyfarm.swf") > 0 Then
               Call login_load  '完成登陆
            ElseIf InStr(login_temp, "蔬菜水果，想种就种") > 0 Then
               If Farmqk = False Then
                    MsgBox "对不起，您的QQ还没开通开心农场!!", 48, "失败提示"
                    Timer1.Enabled = True
               Else
                  Call login_load  '完成登陆
               End If
            End If
        Else
            MsgBox "登陆失败,可能是QQ服务器繁忙!!", 48, "失败提示"
            Timer1.Enabled = True
        End If
        login_temp = ""
    End If
End Sub
Sub login_load()  '开始登陆
    On Error Resume Next
    
    MyQQ = Val(Split(Split(FarmCookies, "uin=o")(1), ";")(0))
    If FZDD(MyQQ) = False Then  '防止多次登录
        Form7.Visible = False
        Form1.Timer1.Enabled = False
        Form1.Timer1.Interval = 10
        Form1.Timer1.Enabled = True
    '    Form1.Visible = True
        
        login = True   '记录已经登陆
        
        Myuid = 0
        csi = 0
    
        If pst = 0 Then
            pst = DateDiff("s", DateSerial(1970, 1, 1), Now()) - 28800
            shicha = time_c - pst
        End If
        
        Debug.Print "时差：" & shicha
    
        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.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.uu23.com"
        
        i = 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
    Else
        Timer1.Enabled = True
    End If
End Sub
Private Sub Winsock2_Connect()
    On Error Resume Next
    Dim strCommand As String
    Dim proxytemp As String
    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; SV1)" & 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
    Winsock2.SendData strCommand
End Sub
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
    On Error Resume Next
    ReDim str(bytesTotal - 1) As Byte
    Winsock2.GetData str, vbArray + vbByte
    login_temp = login_temp & UTF8_Decode(str)
    If InStr(login_temp, "pst=") > 0 Then
        Call Winsock2_Close
    End If
End Sub
Private Sub Winsock2_Close()
    On Error Resume Next
    If Len(login_temp) > 0 Then
        Winsock2.Close
        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
        End If
        
        Debug.Print "时差1：" & shicha
        login_temp = ""
        
    End If
End Sub
Private Sub jzini(qq)
    On Error Resume Next
    Dim sz As String
    Dim T As String, t1 As String, t2 As String
    Dim szini() As String
    Dim szini1() As String
    Dim Temp As String
    Dim sum As Integer
    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 = 4                  '更新好友列表的时间间隔
        xzsj = 15                 '农场被临时限制自动休息
        zdxx = 0                  '是否自动休息
        gzsj = 30                 '工作时间
        xxsj = 15                 '休息时间
        smxx = 0                '扫描休息
        smrs = 250              '扫描人数
        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
End Sub

						