外挂编程

开发平台：
Visual Basic

Form3.frm：源码内容
							VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{D05C3AD7-7EF1-4749-885E-A2006408FC13}#1.0#0"; "VSListview.ocx"
Begin VB.Form Form3 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "我的仓库"
   ClientHeight    =   5625
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5925
   Icon            =   "Form3.frx":0000
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5625
   ScaleWidth      =   5925
   StartUpPosition =   1  '所有者中心
   Begin VB.OptionButton Option3 
      Caption         =   "仓库"
      Height          =   375
      Left            =   2760
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   120
      Value           =   -1  'True
      Width           =   1335
   End
   Begin VB.OptionButton Option2 
      Caption         =   "背包"
      Height          =   375
      Left            =   1440
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   120
      Width           =   1335
   End
   Begin VB.OptionButton Option1 
      Caption         =   "商店"
      Height          =   375
      Left            =   120
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Cancel          =   -1  'True
      Caption         =   "Command1"
      Height          =   255
      Left            =   2160
      TabIndex        =   6
      Top             =   6840
      Width           =   495
   End
   Begin QQ伴侣.XPButton2 XPButton21 
      Height          =   375
      Left            =   4440
      TabIndex        =   5
      Top             =   5175
      Width           =   1335
      _ExtentX        =   2355
      _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.Frame Frame1 
      Caption         =   "果实卖出 (双击可单独出售)"
      Height          =   4455
      Left            =   120
      TabIndex        =   0
      Top             =   600
      Width           =   5675
      Begin MSWinsockLib.Winsock Winsock2 
         Left            =   4200
         Top             =   1800
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         RemotePort      =   10
      End
      Begin VB.Timer Timer1 
         Enabled         =   0   'False
         Interval        =   10
         Left            =   3840
         Top             =   3360
      End
      Begin MSWinsockLib.Winsock Winsock1 
         Left            =   3600
         Top             =   1800
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         RemotePort      =   10
      End
      Begin vsListViewXP.vsListView vsListView1 
         Height          =   4095
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   5430
         _ExtentX        =   9578
         _ExtentY        =   7223
      End
   End
   Begin VB.Label Label2 
      Caption         =   "金币。"
      Height          =   255
      Left            =   2760
      TabIndex        =   4
      Top             =   5280
      Width           =   615
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "0"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   1680
      TabIndex        =   3
      Top             =   5280
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "当前果实总价值￥："
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   5280
      Width           =   1695
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim liebiao As String, maichu As String
Dim dianji As Integer
Dim lx As Integer
Dim POST_cId As Integer
Dim POST_Sum As Integer
Private Sub Form_Load()
    With vsListView1
    '初始化
    Call .Initialize
    '初始化小图标
    Call .InitializeImageListSmall
    '加载资源文件中的Icon
    Call .ImageListSmall_AddIcon(LoadResPicture(101, 1))
    '设置列头
    Call .ColumnAdd(0, "", 0, [caLeft])
    Call .ColumnAdd(1, "ID", 30, [caLeft])
    Call .ColumnAdd(2, "名称", 100, [caLeft])
    Call .ColumnAdd(3, "数量", 70, [caLeft])
    Call .ColumnAdd(4, "单价", 70, [caLeft])
    Call .ColumnAdd(5, "总价", 70, [caLeft])
    '是否支持重画列表
    .RaiseSubItemPrePaint = False
    '是否隐藏列头
    .HeaderHide = False
    '是否支持调整边距
    .HeaderFixedWidth = False
    '是否支持拖动列头
    .HeaderFixedWidth = True
    '是否启用复选框
    vsListView1.CheckBoxes = 0
    '边框风格
    ' cbBorderStyle.ListIndex = 1
    .BorderStyle = bsThick
    '视图
    .ViewMode = vmDetails
    '显示网格
    .GridLines = True
    '整行选择
    .FullRowSelect = True
    '颜色
    .BackColor = &HFFFFFF
    End With
    Timer1.Enabled = True
End Sub
Private Sub Option1_Click()
    On Error Resume Next
    Form1.Timer24.Enabled = True
    qhform = 1
    Unload Form3
End Sub
Private Sub Option2_Click()
    On Error Resume Next
    Form1.Timer24.Enabled = True
    qhform = 2
    Unload Form3
End Sub
'Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    On Error Resume Next
'    Cancel = True
'    Form3.Visible = False
'    Exit Sub
'End Sub
Private Sub Timer1_Timer()
    Timer1.Enabled = False
    With vsListView1
    Call .Clear  '清空
    Call .ItemAdd(vsListView1.Count, "", 0, 0)
    Call .SubItemSet(vsListView1.Count - 1, 1, "", 0)
    Call .SubItemSet(vsListView1.Count - 1, 2, "加载中...", 0)
    End With
    liebiao = ""
    If Proxy = 1 Then  '使用代理
        Winsock1.Close
        Winsock1.RemoteHost = Proxy_IP
        Winsock1.RemotePort = Proxy_DK
        Winsock1.Connect
    Else
        Winsock1.Close
        If Farmqk = True Then
           Winsock1.RemoteHost = "happyfarm.xiaoyou.qq.com"
        Else
           Winsock1.RemoteHost = "happyfarm.qzone.qq.com"
        End If
        Winsock1.RemotePort = 80
        Winsock1.Connect
    End If
End Sub
Private Sub vsListView1_DblClick()
    On Error Resume Next
    Dim sum As Integer
    If vsListView1.Count >= 0 Then
maichu:
        sum = InputBox("卖出果实：" & zhonglei(vsListView1.SubItemText(dianji, 0), 0) & " 单价：(" & vsListView1.SubItemText(dianji, 4) & " 金币)" & vbCrLf & vbCrLf & "请输入要出售的果实个数（1 - " & vsListView1.SubItemText(dianji, 3) & "）：", "果实卖出", vsListView1.SubItemText(dianji, 3))
        If sum > 0 Then
            If sum > vsListView1.SubItemText(dianji, 3) Then
                MsgBox "你没有这么多果实,请重新输入!   ", 48, "失败"
                sum = 0
                GoTo maichu
            Else
    
                POST_cId = vsListView1.SubItemText(dianji, 0)
                POST_Sum = sum
                
                If MsgBox("您确定真的要卖出" & POST_Sum & "个【" & Replace(zhonglei(POST_cId, 0), "　", "") & "】吗？", 64 Or vbYesNo, "出售确认") = vbNo Then
                   Exit Sub
                End If
                XPButton21.Enabled = False
                maichu = ""
                lx = 2
                If Proxy = 1 Then  '使用代理
                    Winsock2.Close
                    Winsock2.RemoteHost = Proxy_IP
                    Winsock2.RemotePort = Proxy_DK
                    Winsock2.Connect
                Else
                    Winsock2.Close
                    If Farmqk = True Then
                       Winsock2.RemoteHost = "happyfarm.xiaoyou.qq.com"
                    Else
                       Winsock2.RemoteHost = "happyfarm.qzone.qq.com"
                    End If
                    Winsock2.RemotePort = 80
                    Winsock2.Connect
                End If
            End If
        End If
    End If
End Sub
Private Sub vsListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
    On Error Resume Next
    If vsListView1.ItemHitTest(X, y) >= 0 Then
        dianji = Val(vsListView1.ItemHitTest(X, y))
    End If
End Sub
Private Sub Winsock1_Connect()
    On Error Resume Next
    Dim strCommand As String
    Dim proxytemp As String
    Randomize Timer
    If Proxy = 1 Then  '使用代理
        If Farmqk = True Then
           proxytemp = "http://happyfarm.xiaoyou.qq.com"
        Else
           proxytemp = "http://happyfarm.qzone.qq.com"
        End If
    End If
    strCommand = "GET " & proxytemp & "/api.php?mod=repertory&act=getUserCrop&farmTime=" & time_c & " 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
    If Farmqk = True Then
       strCommand = strCommand & "Host: happyfarm.xiaoyou.qq.com" & vbCrLf
    Else
       strCommand = strCommand & "Host: happyfarm.qzone.qq.com" & vbCrLf
    End If
    strCommand = strCommand & "Referer: http://appimg.qq.com/happyfarm/module/Main_v_" & flashbb & ".swf" & vbCrLf
    strCommand = strCommand & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)" & vbCrLf
    strCommand = strCommand & "Connection: close" & vbCrLf
    strCommand = strCommand & "Content-Length: " & Len(posttem) & vbCrLf
    strCommand = strCommand & "Cookie: " & FarmCookies & vbCrLf
'    strCommand = strCommand & "Cookie: uin=" & login_uid & "; skey=" & login_skey & "; pst=" & pst - 5 & ";" & 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
    liebiao = liebiao & UTF8_Decode(str)
End Sub
Private Sub Winsock1_Close()
    On Error Resume Next
    Dim temp() As String, tem1 As String, tem2 As String, ListI As Integer
    Dim cName As String, amount As Long, price As Long, sum As Long, cId As Integer
    Winsock1.Close
    If Len(liebiao) > 0 Then
        vsListView1.Clear
        Label3.Caption = 0
        If InStr(liebiao, "[{""cId""") > 0 Then
            If InStr(liebiao, "},{") > 0 Then
                temp = Split(liebiao, "},{")
                For i = 0 To UBound(temp())
                    cId = split_m(1, temp(i), "cId")
                    cName = vbUnEscape(split_m(3, temp(i), "cName"))
                    amount = split_m(1, temp(i), "amount")
                    price = split_m(2, temp(i), "price")
                    With vsListView1
                    ListI = ListI + 1
                    Call .ItemAdd(vsListView1.Count, cId, 0, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 1, ListI, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 2, cName, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 3, amount, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 4, price, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 5, price * amount, 0)
                    End With
                    sum = sum + amount * price
                Next i
            Else
                cId = split_m(1, liebiao, "cId")
                cName = vbUnEscape(split_m(3, liebiao, "cName"))
                amount = split_m(1, liebiao, "amount")
                price = split_m(2, liebiao, "price")
                With vsListView1
                ListI = ListI + 1
                Call .ItemAdd(vsListView1.Count, cId, 0, 0)
                Call .SubItemSet(vsListView1.Count - 1, 1, ListI, 0)
                Call .SubItemSet(vsListView1.Count - 1, 2, cName, 0)
                Call .SubItemSet(vsListView1.Count - 1, 3, amount, 0)
                Call .SubItemSet(vsListView1.Count - 1, 4, price, 0)
                Call .SubItemSet(vsListView1.Count - 1, 5, price * amount, 0)
                End With
                sum = amount * price
            End If
            Label3.Caption = sum
        End If
    End If
End Sub
Private Sub XPButton21_Click()
    On Error Resume Next
    If vsListView1.Count > 0 Then
        If MsgBox("您确定真的要卖出所有的果实吗？", 64 Or vbYesNo, "出售确认") = vbNo Then
            Exit Sub
        End If
    
        XPButton21.Enabled = False
        maichu = ""
        lx = 1
        If Proxy = 1 Then  '使用代理
            Winsock2.Close
            Winsock2.RemoteHost = Proxy_IP
            Winsock2.RemotePort = Proxy_DK
            Winsock2.Connect
        Else
            Winsock2.Close
            If Farmqk = True Then
               Winsock2.RemoteHost = "happyfarm.xiaoyou.qq.com"
            Else
               Winsock2.RemoteHost = "happyfarm.qzone.qq.com"
            End If
            Winsock2.RemotePort = 80
            Winsock2.Connect
        End If
    Else
        MsgBox "你的仓库空空的，没什么可以出售!", 48, "卖出失败"
    End If
End Sub
Private Sub Winsock2_Connect()
    On Error Resume Next
    Dim strCommand As String
    Dim posttem As String
    Dim proxytemp As String
    Randomize Timer
    If Proxy = 1 Then  '使用代理
        If Farmqk = True Then
           proxytemp = "http://happyfarm.xiaoyou.qq.com"
        Else
           proxytemp = "http://happyfarm.qzone.qq.com"
        End If
    End If
    If lx = 1 Then
        posttem = "farmKey=" & Farmkey_cx & "&farmTime=" & time_cx
        strCommand = "POST " & proxytemp & "/api.php?mod=repertory&act=saleAll HTTP/1.1" & vbCrLf
    ElseIf lx = 2 Then
        posttem = "cId=" & POST_cId & "&farmKey=" & Farmkey_cx & "&farmTime=" & time_cx & "&number=" & POST_Sum
        strCommand = "POST " & proxytemp & "/api.php?mod=repertory&act=sale HTTP/1.1" & vbCrLf
    End If
    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
    If Farmqk = True Then
       strCommand = strCommand & "Host: happyfarm.xiaoyou.qq.com" & vbCrLf
    Else
       strCommand = strCommand & "Host: happyfarm.qzone.qq.com" & vbCrLf
    End If
    strCommand = strCommand & "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    strCommand = strCommand & "Referer: http://appimg.qq.com/happyfarm/module/Main_v_" & flashbb & ".swf" & vbCrLf
    strCommand = strCommand & "x-flash-version: " & flash & vbCrLf
    strCommand = strCommand & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)" & vbCrLf
    strCommand = strCommand & "Connection: close" & vbCrLf
    strCommand = strCommand & "Content-Length: " & Len(posttem) & vbCrLf
    strCommand = strCommand & "Cookie: " & FarmCookies & vbCrLf
'    strCommand = strCommand & "Cookie: uin=" & login_uid & "; skey=" & login_skey & "; pst=" & pst - 5 & ";" & vbCrLf
    strCommand = strCommand & vbCrLf
    strCommand = strCommand & posttem
    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
    maichu = maichu & UTF8_Decode(str)
End Sub
Private Sub Winsock2_Close()
    On Error Resume Next
    Dim code As Integer, money As String
    Winsock2.Close
    If Len(maichu) > 0 Then
        '记录QQ服务器时间
        If InStr(maichu, "Set-Cookie: pst=") > 0 Then
            Dim pst_temp As Long, tem1 As String
            tem1 = Split(maichu, "Set-Cookie: pst=")(1)
            pst_temp = Val(Split(tem1, ";")(0))
            If pst_temp > 0 Then pst = pst_temp
        End If
        code = split_m(1, maichu, "code")
        If code = 1 Then
            money = split_m(2, maichu, "money")
            maichu = ""
            Timer1.Enabled = True
            If lx = 1 Then
                Call jilu("卖出", MyQQ, "你卖出了仓库中所有的果实,获得了金币￥" & money)
                MsgBox "恭喜你!成功卖出了仓库中所有果实,获得了金币￥" & money, 64, "卖出成功"
            ElseIf lx = 2 Then
                Call jilu("卖出", MyQQ, "你卖出了" & POST_Sum & "个【" & Replace(zhonglei(POST_cId, 0), "　", "") & "】,获得了金币￥" & money)
                MsgBox "恭喜你!成功卖出了" & POST_Sum & "个【" & Replace(zhonglei(POST_cId, 0), "　", "") & "】,获得了金币￥" & money, 64, "卖出成功"
            End If
            If Farmqk = True Then
               Call addsxlb(Myuid, 0)
            Else
               Call addsxlb(Myuid, 1)
            End If
        ElseIf eode = 0 Then
            Call jilu("卖出", MyQQ, "你的仓库空空的，没什么可以出售!")
            Timer1.Enabled = True
            maichu = ""
            MsgBox "你的仓库空空的，没什么可以出售!", 48, "卖出失败"
        Else
            maichu = ""
            Timer1.Enabled = True
            MsgBox "连接系统失败，可能是QQ服务器系统繁忙!", 48, "卖出失败"
        End If
        XPButton21.Enabled = True
    End If
End Sub
Private Sub Command1_Click()
    Form3.Visible = False
End Sub

						