外挂编程

开发平台：
Visual Basic

Form4.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 Form4 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "商店购物"
   ClientHeight    =   6210
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   7140
   Icon            =   "Form4.frx":0000
   LinkTopic       =   "Form4"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6210
   ScaleWidth      =   7140
   StartUpPosition =   1  '所有者中心
   Begin VB.OptionButton Option3 
      Caption         =   "仓库"
      Height          =   375
      Left            =   2760
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   120
      Width           =   1335
   End
   Begin VB.OptionButton Option2 
      Caption         =   "背包"
      Height          =   375
      Left            =   1440
      Style           =   1  'Graphical
      TabIndex        =   11
      Top             =   120
      Width           =   1335
   End
   Begin VB.OptionButton Option1 
      Caption         =   "商店"
      Height          =   375
      Left            =   120
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   120
      Value           =   -1  'True
      Width           =   1335
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   4560
      Top             =   4560
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   3720
      Top             =   4680
   End
   Begin VB.Frame Frame1 
      Caption         =   "种子商店"
      Height          =   5535
      Left            =   120
      TabIndex        =   0
      Top             =   600
      Width           =   6895
      Begin VB.Timer Timer4 
         Enabled         =   0   'False
         Interval        =   10
         Left            =   3480
         Top             =   3840
      End
      Begin VB.Timer Timer3 
         Enabled         =   0   'False
         Interval        =   20
         Left            =   5280
         Top             =   4320
      End
      Begin MSWinsockLib.Winsock Winsock1 
         Left            =   5160
         Top             =   3600
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
         RemotePort      =   10
      End
      Begin QQ伴侣.XPButton2 XPButton22 
         Cancel          =   -1  'True
         Height          =   375
         Left            =   5980
         TabIndex        =   9
         Top             =   5040
         Width           =   755
         _ExtentX        =   1323
         _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 XPButton21 
         Height          =   375
         Left            =   5020
         TabIndex        =   8
         Top             =   5040
         Width           =   755
         _ExtentX        =   1323
         _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.TextBox Text1 
         Alignment       =   2  'Center
         ForeColor       =   &H000000FF&
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   2400
         MaxLength       =   3
         TabIndex        =   5
         Text            =   "1"
         Top             =   5090
         Width           =   615
      End
      Begin vsListViewXP.vsListView vsListView1 
         Height          =   4695
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   6630
         _ExtentX        =   11695
         _ExtentY        =   8281
      End
      Begin VB.Label Label7 
         Caption         =   "125"
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   4330
         TabIndex        =   7
         Top             =   5145
         Width           =   600
      End
      Begin VB.Label Label6 
         Caption         =   "总价￥："
         Height          =   255
         Left            =   3600
         TabIndex        =   6
         Top             =   5145
         Width           =   735
      End
      Begin VB.Image Image2 
         Height          =   255
         Left            =   2040
         MouseIcon       =   "Form4.frx":038A
         MousePointer    =   99  'Custom
         Picture         =   "Form4.frx":04DC
         Top             =   5085
         Width           =   255
      End
      Begin VB.Image Image1 
         Height          =   255
         Left            =   3120
         MouseIcon       =   "Form4.frx":056F
         MousePointer    =   99  'Custom
         Picture         =   "Form4.frx":06C1
         Top             =   5085
         Width           =   255
      End
      Begin VB.Label Label5 
         Caption         =   "数量："
         Height          =   255
         Left            =   1440
         TabIndex        =   4
         Top             =   5145
         Width           =   590
      End
      Begin VB.Label Label2 
         Caption         =   "白萝卜"
         ForeColor       =   &H000000FF&
         Height          =   255
         Left            =   720
         TabIndex        =   3
         Top             =   5145
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "名称："
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   5145
         Width           =   615
      End
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dj As Boolean
Dim jiage As Integer
Dim id As Integer
Dim mairu As String
Private Sub Form_Load()
    On Error Resume Next
    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, "等级", 50, [caLeft])
    Call .ColumnAdd(4, "价格/￥", 60, [caLeft])
    Call .ColumnAdd(5, "周期/时", 60, [caLeft])
    Call .ColumnAdd(6, "最高收益", 60, [caLeft])
    Call .ColumnAdd(7, "总经验值", 60, [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
    Timer4.Enabled = True
    id = 2
    jiage = 125  '初始化价格
End Sub
Private Sub Option2_Click()
    On Error Resume Next
    Form1.Timer24.Enabled = True
    qhform = 2
    Unload Form4
End Sub
Private Sub Option3_Click()
    On Error Resume Next
    Form1.Timer24.Enabled = True
    qhform = 3
    Unload Form4
End Sub
Private Sub Timer4_Timer()
    Timer4.Enabled = False
    vsListView1.Clear
    Call jiazai
End Sub
Sub jiazai()   '加载数据
    On Error Resume Next
    Dim k_temp As String
    Dim kind_temp() As String
    Dim ListI As Integer
    If Val(kind_sum) > 0 Then
        For i = 0 To Val(kind_sum)
            kind_temp = Split(kind(i), ",")
            If UBound(kind_temp()) > 1 Then
                If Val(kind_temp(8)) = 1 Then
                    With vsListView1
                    ListI = ListI + 1
                    Call .ItemAdd(vsListView1.Count, kind_temp(1), 0, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 1, ListI, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 2, kind_temp(0), 0)
                    Call .SubItemSet(vsListView1.Count - 1, 3, kind_temp(3), 0)
                    Call .SubItemSet(vsListView1.Count - 1, 4, kind_temp(4), 0)
                    Call .SubItemSet(vsListView1.Count - 1, 5, kind_temp(2)  3600, 0)
                    Call .SubItemSet(vsListView1.Count - 1, 6, kind_temp(6), 0)
                    Call .SubItemSet(vsListView1.Count - 1, 7, kind_temp(7), 0)
                    End With
                End If
            End If
        Next i
    End If
End Sub
'Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    On Error Resume Next
'    Cancel = True
'    Form4.Visible = False
'    Exit Sub
'End Sub
Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
    dj = True
    Call Timer1_Timer
End Sub
Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
    dj = False
    Timer1.Enabled = False
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
    dj = True
    Call Timer2_Timer
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
    dj = False
    Timer2.Enabled = False
End Sub
Private Sub Text1_Change()
    On Error Resume Next
    If Val(Text1.Text) > 99 Then Text1.Text = 99
    Text1.SelStart = Len(Text1.Text)
    Label7.Caption = Val(Text1.Text) * jiage
End Sub
Private Sub Label2_Change()
    On Error Resume Next
    Label7.Caption = Val(Text1.Text) * jiage
End Sub
Private Sub Timer1_Timer()
    On Error Resume Next
    Dim i As Integer
    If dj = True Then
        Timer1.Enabled = True
        i = Val(Text1.Text) - 1
        If i < 1 Then i = 1
        Text1.Text = i
        Text1.SelStart = Len(Text1.Text)
    End If
End Sub
Private Sub Timer2_Timer()
    On Error Resume Next
    Dim i As Integer
    If dj = True Then
        Timer2.Enabled = True
        i = Val(Text1.Text) + 1
        If i > 99 Then i = 99
        Text1.Text = i
        Text1.SelStart = Len(Text1.Text)
    End If
End Sub
Private Sub Timer3_Timer()
    Timer3.Enabled = False
    mairu = ""
    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 XPButton21_Click()
    If Len(Text1.Text) = 0 Then Text1.Text = 1
    If vsListView1.Count > 0 Then
        If MsgBox("您确定要花费￥" & Label7.Caption & "金币,购买" & Text1.Text & "颗《" & Label2.Caption & "》种子吗？", 32 Or vbYesNo, "购买确认") = vbYes Then
            XPButton21.Enabled = False
            Timer3.Enabled = True
        End If
    Else
        MsgBox "商店好像空空的，没有卖任何东西？", 48, "买入失败"
    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
    posttem = "cId=" & id & "&number=" & Val(Text1.Text) & "&farmTime=" & Time_Cx & "&farmKey=" & Farmkey_cx
    strCommand = "POST " & proxytemp & "/api.php?mod=repertory&act=buySeed 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 & "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    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
    strCommand = strCommand & posttem
    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
    mairu = mairu & UTF8_Decode(str)
End Sub
Private Sub Winsock1_Close()
    On Error Resume Next
    Dim code As Integer, money As String
    Winsock1.Close
    If Len(mairu) > 0 Then
        '记录QQ服务器时间
        If InStr(mairu, "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, mairu, "code")
        If code = 1 Then
            money = Abs(split_m(2, mairu, "money"))
            Num = split_m(1, mairu, "num")
            cId = split_m(1, mairu, "cId")
            mybox = mybox & "/" & cId & "|" & Text1.Text & "//"
            Call jilu("购物", MyQQ, "你花了￥" & money & ",购买" & Text1.Text & "颗《" & Label2.Caption & "》种子")
            Form1.Label6.Caption = Val(Form1.Label6.Caption) - money
            mairu = ""
            Timer1.Enabled = True
            MsgBox "购买成功，一共花了￥" & money, 64, "购买成功"
            If Farmqk = True Then
               Call addsxlb(Myuid, 0)
            Else
               Call addsxlb(Myuid, 1)
            End If
        ElseIf eode = 0 Then
            Dim direction As String
            direction = vbUnEscape(split_m(3, mairu, "direction"))
            Call jilu("购物", MyQQ, direction)
            mairu = ""
            MsgBox direction, 48, "买入失败"
        Else
            mairu = ""
            MsgBox "连接系统失败，可能是QQ服务器系统繁忙!", 48, "购物失败"
        End If
        Form1.bbi = 300
        XPButton21.Enabled = True
    End If
End Sub
Private Sub XPButton22_Click()
    Form4.Visible = False
End Sub
Private Sub vsListView1_MouseDown(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))
        id = Val(vsListView1.SubItemText(dianji, 0))
        jiage = Val(vsListView1.SubItemText(dianji, 4))
        Label2.Caption = vsListView1.SubItemText(dianji, 2)
    End If
End Sub
Private Sub vsListView1_ItemClick(Item As Integer)  '按方向键
    On Error Resume Next
    If Item >= 0 Then
        dianji = Item
        id = Val(vsListView1.SubItemText(dianji, 0))
        jiage = Val(vsListView1.SubItemText(dianji, 4))
        Label2.Caption = vsListView1.SubItemText(dianji, 2)
    End If
End Sub

						