VB.net 2010 视频教程 VB.net 2010 视频教程 python基础视频教程
SQL Server 2008 视频教程 c#入门经典教程 Visual Basic从门到精通视频教程
当前位置:
首页 > VB.net教程 >
  • QQ对对碰外挂VB.NET版

  前两天网上狂传对对碰游戏外挂的VC++源码,为了研究VB.NET和API技术,我便用VB.NET写了对对碰游戏外挂,因为时间不足和本人的技术有限,只做了个半成品,先挂在网上存着吧,以后有时间继续完善.

Option Explicit On
Option Strict On
Public Class QQD
    Inherits System.Windows.Forms.Form

#Region " Windows 窗体设计器生成的代码 "

    Public Sub New()
        MyBase.New()

        '该调用是 Windows 窗体设计器所必需的。
        InitializeComponent()

        '在 InitializeComponent() 调用之后添加任何初始化

    End Sub

    '窗体重写 dispose 以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Windows 窗体设计器所必需的
    Private components As System.ComponentModel.IContainer

    '注意: 以下过程是 Windows 窗体设计器所必需的
    '可以使用 Windows 窗体设计器修改此过程。
    '不要使用代码编辑器修改它。
    Friend WithEvents btnAutoClear As System.Windows.Forms.Button
    Friend WithEvents btnClose As System.Windows.Forms.Button
    Friend WithEvents btnInsert As System.Windows.Forms.Button
    Friend WithEvents btnManualClear As System.Windows.Forms.Button
    Friend WithEvents btnStop As System.Windows.Forms.Button
    Friend WithEvents timeCheck As System.Windows.Forms.Timer
    Friend WithEvents lblTime As System.Windows.Forms.Label
    Friend WithEvents timeWait As System.Windows.Forms.Timer
    Friend WithEvents trbWaitTime As System.Windows.Forms.TrackBar
    Friend WithEvents txtWaitTime As System.Windows.Forms.TextBox
    Friend WithEvents lblWaitTime As System.Windows.Forms.Label
    Friend WithEvents chkQuick As System.Windows.Forms.CheckBox
    Friend WithEvents btnPrompt As System.Windows.Forms.Button
    Friend WithEvents btnUnInsert As System.Windows.Forms.Button
    Friend WithEvents chkAutoStart As System.Windows.Forms.CheckBox
    Friend WithEvents chkMouse As System.Windows.Forms.CheckBox
    Friend WithEvents chkUseProp As System.Windows.Forms.CheckBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Me.btnAutoClear = New System.Windows.Forms.Button
        Me.btnClose = New System.Windows.Forms.Button
        Me.btnInsert = New System.Windows.Forms.Button
        Me.btnManualClear = New System.Windows.Forms.Button
        Me.btnStop = New System.Windows.Forms.Button
        Me.timeCheck = New System.Windows.Forms.Timer(Me.components)
        Me.trbWaitTime = New System.Windows.Forms.TrackBar
        Me.txtWaitTime = New System.Windows.Forms.TextBox
        Me.lblTime = New System.Windows.Forms.Label
        Me.timeWait = New System.Windows.Forms.Timer(Me.components)
        Me.lblWaitTime = New System.Windows.Forms.Label
        Me.chkQuick = New System.Windows.Forms.CheckBox
        Me.btnPrompt = New System.Windows.Forms.Button
        Me.btnUnInsert = New System.Windows.Forms.Button
        Me.chkAutoStart = New System.Windows.Forms.CheckBox
        Me.chkMouse = New System.Windows.Forms.CheckBox
        Me.chkUseProp = New System.Windows.Forms.CheckBox
        CType(Me.trbWaitTime, System.ComponentModel.ISupportInitialize).BeginInit()
        Me.SuspendLayout()
        '
        'btnAutoClear
        '
        Me.btnAutoClear.Location = New System.Drawing.Point(184, 8)
        Me.btnAutoClear.Name = "btnAutoClear"
        Me.btnAutoClear.TabIndex = 1
        Me.btnAutoClear.Text = "自动消除"
        '
        'btnClose
        '
        Me.btnClose.Location = New System.Drawing.Point(360, 72)
        Me.btnClose.Name = "btnClose"
        Me.btnClose.Size = New System.Drawing.Size(48, 23)
        Me.btnClose.TabIndex = 2
        Me.btnClose.Text = "关闭"
        '
        'btnInsert
        '
        Me.btnInsert.Location = New System.Drawing.Point(8, 8)
        Me.btnInsert.Name = "btnInsert"
        Me.btnInsert.TabIndex = 4
        Me.btnInsert.Text = "注入"
        '
        'btnManualClear
        '
        Me.btnManualClear.Location = New System.Drawing.Point(280, 72)
        Me.btnManualClear.Name = "btnManualClear"
        Me.btnManualClear.TabIndex = 0
        Me.btnManualClear.Text = "手动消除"
        '
        'btnStop
        '
        Me.btnStop.Location = New System.Drawing.Point(272, 8)
        Me.btnStop.Name = "btnStop"
        Me.btnStop.Size = New System.Drawing.Size(136, 23)
        Me.btnStop.TabIndex = 3
        Me.btnStop.Text = "停止自动消除(F12)"
        '
        'timeCheck
        '
        '
        'trbWaitTime
        '
        Me.trbWaitTime.Location = New System.Drawing.Point(64, 72)
        Me.trbWaitTime.Maximum = 40
        Me.trbWaitTime.Name = "trbWaitTime"
        Me.trbWaitTime.Size = New System.Drawing.Size(136, 45)
        Me.trbWaitTime.TabIndex = 5
        Me.trbWaitTime.TickStyle = System.Windows.Forms.TickStyle.None
        '
        'txtWaitTime
        '
        Me.txtWaitTime.Enabled = False
        Me.txtWaitTime.Location = New System.Drawing.Point(200, 72)
        Me.txtWaitTime.Name = "txtWaitTime"
        Me.txtWaitTime.Size = New System.Drawing.Size(40, 21)
        Me.txtWaitTime.TabIndex = 6
        Me.txtWaitTime.Text = ""
        '
        'lblTime
        '
        Me.lblTime.Location = New System.Drawing.Point(240, 80)
        Me.lblTime.Name = "lblTime"
        Me.lblTime.Size = New System.Drawing.Size(32, 16)
        Me.lblTime.TabIndex = 7
        Me.lblTime.Text = "毫秒"
        '
        'timeWait
        '
        '
        'lblWaitTime
        '
        Me.lblWaitTime.Location = New System.Drawing.Point(16, 80)
        Me.lblWaitTime.Name = "lblWaitTime"
        Me.lblWaitTime.Size = New System.Drawing.Size(40, 23)
        Me.lblWaitTime.TabIndex = 8
        Me.lblWaitTime.Text = "延时:"
        '
        'chkQuick
        '
        Me.chkQuick.Location = New System.Drawing.Point(16, 40)
        Me.chkQuick.Name = "chkQuick"
        Me.chkQuick.Size = New System.Drawing.Size(80, 24)
        Me.chkQuick.TabIndex = 9
        Me.chkQuick.Text = "加快速度"
        '
        'btnPrompt
        '
        Me.btnPrompt.Location = New System.Drawing.Point(344, 40)
        Me.btnPrompt.Name = "btnPrompt"
        Me.btnPrompt.Size = New System.Drawing.Size(64, 24)
        Me.btnPrompt.TabIndex = 10
        Me.btnPrompt.Text = "提示"
        '
        'btnUnInsert
        '
        Me.btnUnInsert.Location = New System.Drawing.Point(96, 8)
        Me.btnUnInsert.Name = "btnUnInsert"
        Me.btnUnInsert.TabIndex = 11
        Me.btnUnInsert.Text = "撤消注入"
        '
        'chkAutoStart
        '
        Me.chkAutoStart.Location = New System.Drawing.Point(176, 40)
        Me.chkAutoStart.Name = "chkAutoStart"
        Me.chkAutoStart.Size = New System.Drawing.Size(80, 24)
        Me.chkAutoStart.TabIndex = 12
        Me.chkAutoStart.Text = "自动开始"
        '
        'chkMouse
        '
        Me.chkMouse.Location = New System.Drawing.Point(96, 40)
        Me.chkMouse.Name = "chkMouse"
        Me.chkMouse.Size = New System.Drawing.Size(80, 24)
        Me.chkMouse.TabIndex = 13
        Me.chkMouse.Text = "模拟鼠标"
        '
        'chkUseProp
        '
        Me.chkUseProp.Location = New System.Drawing.Point(256, 40)
        Me.chkUseProp.Name = "chkUseProp"
        Me.chkUseProp.Size = New System.Drawing.Size(80, 24)
        Me.chkUseProp.TabIndex = 14
        Me.chkUseProp.Text = "使用道具"
        '
        'QQD
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(418, 104)
        Me.Controls.Add(Me.chkUseProp)
        Me.Controls.Add(Me.chkMouse)
        Me.Controls.Add(Me.chkAutoStart)
        Me.Controls.Add(Me.btnUnInsert)
        Me.Controls.Add(Me.btnPrompt)
        Me.Controls.Add(Me.chkQuick)
        Me.Controls.Add(Me.lblWaitTime)
        Me.Controls.Add(Me.lblTime)
        Me.Controls.Add(Me.txtWaitTime)
        Me.Controls.Add(Me.trbWaitTime)
        Me.Controls.Add(Me.btnAutoClear)
        Me.Controls.Add(Me.btnClose)
        Me.Controls.Add(Me.btnInsert)
        Me.Controls.Add(Me.btnManualClear)
        Me.Controls.Add(Me.btnStop)
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
        Me.Name = "QQD"
        Me.Text = "QQ对对碰外挂"
        Me.TopMost = True
        CType(Me.trbWaitTime, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub

#End Region

#Region " 代码声明 "

    'API声明
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    Private Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Integer) As Integer
    Private Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer) As Integer
    Private Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
    Private Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Integer, ByRef lpRect As Rectangle) As Integer
    Private Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (ByRef lpPoint As Point) As Integer
    Private Declare Function SetCursorPos Lib "user32" Alias "SetCursorPos" (ByVal lpPoint As Point) As Integer
    Private Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Integer, ByVal dx As Integer, ByVal dy As Integer, ByVal cButtons As Integer, ByVal dwExtraInfo As Integer)
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Integer
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Point) As Integer
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Declare Function GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As Integer, ByRef lpdwProcessId As Integer) As Integer
    Private Declare Function OpenProcess Lib "kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcessId As Integer) As Integer
    Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Integer, ByVal lpAddress As Integer, ByVal dwSize As Integer, ByVal flAllocationType As Integer, ByVal flProtect As Integer) As Integer
    Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByVal lpNumberOfBytesWritten As Integer) As Integer
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Integer, ByVal lpProcName As String) As Integer
    Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Integer, ByVal lpThreadAttributes As Integer, ByVal dwStackSize As Integer, ByVal lpStartAddress As Integer, ByVal lpParameter As Integer, ByVal dwCreationFlags As Integer, ByVal lpThreadId As Integer) As Integer
    Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As Integer
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Integer
    Private Declare Function FillRect Lib "user32" Alias "FillRect" (ByVal hdc As Integer, ByRef lpRect As RECT, ByVal hBrush As Integer) As Integer
    Private Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" (ByVal crColor As Integer) As Integer
    Private Declare Function GetSysColorBrush Lib "user32" Alias "GetSysColorBrush" (ByVal nIndex As Integer) As Integer

    'API常量
    Public Const PROCESS_ALL_ACCESS As Integer = 2035711
    Public Const MEM_COMMIT As Integer = &H1000
    Public Const PAGE_READWRITE As Integer = &H4
    Public Const INFINITE As Integer = &HFFFF

    '鼠标事件常量
    Public Const MOUSEEVENTF_LEFTDOWN As Integer = &H2
    Public Const MOUSEEVENTF_LEFTUP As Integer = &H4

    Public Const MK_LBUTTON As Integer = &H1
    Public Const WM_MOUSEMOVE As Integer = &H200
    Public Const WM_LBUTTONDOWN As Integer = &H201
    Public Const WM_LBUTTONUP As Integer = &H202

    Public Const MK_RBUTTON As Integer = &H2
    Public Const WM_RBUTTONDOWN As Integer = &H204
    Public Const WM_RBUTTONUP As Integer = &H205

    Public Const BM_SETSTATE As Integer = &HF3

    Public Const F12 As Integer = 123

    '方块类型定义
    Public Enum BOX_TYPE
        Ox = 0
        Dog = 1
        Panda = 2
        Chicken = 3
        Cat = 4
        Frog = 5
        Monkey = 6
    End Enum

    '自定义方块数据类型x,y为方块坐标,type为方块类型.
    Public Structure BOX
        Public x As Integer
        Public y As Integer
        Public type As BOX_TYPE
    End Structure

    Public Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure

    Public g_WindowHwnd As Integer
    Public WaitTime As Integer = 200

    '方块矩阵 (8*8)
    Public Boxs(7, 7) As BOX

    '自定义常量
    '游戏区左上角坐标
    Const GAME_LEFT As Integer = 176
    Const GAME_TOP As Integer = 102
    '每个方块的长宽
    Const BOX_WIDTH As Integer = 48
    Const BOX_HEIGHT As Integer = 48

    Private bolPrompt As Boolean = False

#End Region

#Region " 窗体自动执行 "

    Private Sub QQD_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '在此处放置初始化页的用户代码

        trbWaitTime.Value = CInt(WaitTime / 400)
        txtWaitTime.Text = CStr(WaitTime)

    End Sub

#End Region

#Region " 执行注入 "

    Private Sub btnInsert_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnInsert.Click
        Dim l As Integer

        '获取对对碰游戏窗口句柄
        g_WindowHwnd = FindWindow(vbNullString, "对对碰")

        '判断对对碰游戏是否打开
        If g_WindowHwnd <> 0 Then
            '注入DLL文件名
            Dim DllName As String = Environment.CurrentDirectory & "\Twin.dll"
            '注入DLL文件名长度
            Dim dwSize As Integer = System.Text.Encoding.Default.GetByteCount(DllName) + 1
            '对对碰游戏线程ID
            Dim ProcessId As Integer
            '根据对对碰游戏窗口句柄获取对对碰游戏线程ID
            l = GetWindowThreadProcessId(g_WindowHwnd, ProcessId)
            '判断是否获取对对碰游戏线程ID
            If l <> 0 Then
                '根据线程ID打开对对碰游戏线程
                Dim hRemoteProcess As Integer = OpenProcess(PROCESS_ALL_ACCESS, CInt(True), ProcessId)
                '判断是否打开对对碰游戏线程
                If hRemoteProcess <> 0 Then
                    '根据线程ID在指定线程给指定DLL分配内存并返回内存地址
                    Dim pFileRemote As Integer = VirtualAllocEx(hRemoteProcess, 0&, dwSize, MEM_COMMIT, PAGE_READWRITE)
                    '判断分配内存是否成功
                    If pFileRemote <> 0 Then
                        '将指定DLL写入指定线程
                        l = WriteProcessMemory(hRemoteProcess, pFileRemote, DllName, dwSize, 0&)
                        '判断是否将指定DLL写入指定线程
                        If l <> 0 Then
                            '执行注入的DLL并返回地址
                            Dim pfnStartAddr As Integer = GetProcAddress(GetModuleHandle("Kernel32"), "LoadLibraryA")
                            '判断注入的DLL是否执行
                            If pfnStartAddr <> 0 Then
                                Dim hThread As Integer = CreateRemoteThread(hRemoteProcess, 0&, 0&, pfnStartAddr, pFileRemote, 0, 0&)
                                If hThread <> 0 Then
                                    WaitForSingleObject(hThread, INFINITE)
                                    CloseHandle(hThread)
                                    CloseHandle(hRemoteProcess)
                                    MsgBox("注入成功!")
                                Else
                                    MsgBox("注入的DLL执行错误!")
                                End If
                            Else
                                MsgBox("注入的DLL执行错误!")
                            End If
                        Else
                            MsgBox("将DLL写入指定线程错误!")
                        End If
                    Else
                        MsgBox("分配内存错误!")
                    End If
                Else
                    MsgBox("未打开线程!")
                End If
            Else
                MsgBox("获取线程ID错误!")
            End If
        Else
            MsgBox("请打开对对碰游戏!")
        End If

    End Sub

#End Region

#Region " 游戏提示 "

    Private Sub btnPrompt_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPrompt.Click

        '获取对对碰游戏窗口句柄
        g_WindowHwnd = FindWindow(vbNullString, "对对碰")

        '判断对对碰游戏是否打开
        If g_WindowHwnd = 0 Then
            MsgBox("请打开对对碰游戏!")
            Exit Sub
        End If

        bolPrompt = True
        KillBox()
        bolPrompt = False

    End Sub

#End Region

#Region " 手动消除 "

    Private Sub btnManualClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnManualClear.Click

        '获取对对碰游戏窗口句柄
        g_WindowHwnd = FindWindow(vbNullString, "对对碰")

        '判断对对碰游戏是否打开
        If g_WindowHwnd = 0 Then
            MsgBox("请打开对对碰游戏!")
            Exit Sub
        End If

        '执行一次消除
        KillBox()

    End Sub

#End Region

#Region " 自动消除 "

    Private Sub btnAutoClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAutoClear.Click

        '获取对对碰游戏窗口句柄
        g_WindowHwnd = FindWindow(vbNullString, "对对碰")

        '判断对对碰游戏是否打开
        If g_WindowHwnd = 0 Then
            MsgBox("请打开对对碰游戏!")
            Exit Sub
        End If

        timeCheck.Interval = 10
        timeCheck.Enabled = True

        timeWait.Interval = WaitTime
        timeWait.Enabled = True

        btnAutoClear.Enabled = False
        btnManualClear.Enabled = False
        btnClose.Enabled = False

    End Sub

    Private Sub timeWait_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timeWait.Tick

        KillBox()

    End Sub

#End Region

#Region " 设置自动消除延迟时间 "

    Private Sub trbWaitTime_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles trbWaitTime.Scroll

        WaitTime = trbWaitTime.Value * 100
        txtWaitTime.Text = CStr(WaitTime)

    End Sub

#End Region

#Region " 停止自动消除 "

    Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click

        StopAutoClear()

    End Sub

    Private Sub timeCheck_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles timeCheck.Tick

        If CType(GetAsyncKeyState(F12), Boolean) Then
            StopAutoClear()
        End If

    End Sub

    Public Sub StopAutoClear()

        timeWait.Enabled = False

        btnAutoClear.Enabled = True
        btnManualClear.Enabled = True
        btnClose.Enabled = True

    End Sub

#End Region

#Region " 关闭外挂 "

    Private Sub btnClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClose.Click

        QQD.ActiveForm.Close()
        Application.Exit()

    End Sub

#End Region

#Region " 获取指定坐标的颜色 "

    Public Function GetColor(ByVal newX As Integer, ByVal newY As Integer) As Integer

        Dim WindowDC As Integer

        '获取游戏场景
        WindowDC = GetDC(g_WindowHwnd)

        '取场景中(newX,newY)坐标的颜色
        GetColor = GetPixel(WindowDC, newX, newY)

        '释放场景
        ReleaseDC(g_WindowHwnd, WindowDC)

    End Function

#End Region

#Region " 获取各个方块的类型 "

    Public Function GetBoxs() As BOX

        Dim i As Integer                        '矩阵行
        Dim j As Integer                        '矩阵列
        Dim color1 As Integer                   '颜色 (22,22)处
        Dim color2 As Integer                   '颜色 (22,17)处

        Dim Panda, Chicken, Dog, Frog, Monkey, Cat, Ox As String

        For i = 0 To 7
            For j = 0 To 7
                With Boxs(i, j)

                    '获取每个方块的坐标(22,22)坐标
                    .x = GAME_LEFT + 22 + BOX_WIDTH * j
                    .y = GAME_TOP + 22 + BOX_HEIGHT * i

                    '取每个方块坐标(22,22)和(22,17)位置的颜色
                    color1 = GetColor(.x, .y)
                    color2 = GetColor(.x, .y - 5)

                    '用两点颜色确定一个方块类型.
                    If color1 = 16777215 And color2 = 16777215 Then .type = BOX_TYPE.Panda
                    If color1 = 2097151 And color2 = 1353909 Then .type = BOX_TYPE.Chicken
                    If color1 = 4473924 And color2 = 14209230 Then .type = BOX_TYPE.Dog
                    If color1 = 13828048 And color2 = 3862322 Then .type = BOX_TYPE.Frog
                    If color1 = 8623264 And color2 = 5805536 Then .type = BOX_TYPE.Monkey
                    If color1 = 10921638 And color2 = 9408399 Then .type = BOX_TYPE.Cat
                    If color1 = 15398649 And color2 = 1655140 Then .type = BOX_TYPE.Ox

                End With
            Next j
        Next i

    End Function

#End Region

#Region " 模拟鼠标 "

    Public Sub MouseClick(ByVal x As Integer, ByVal y As Integer, ByVal x1 As Integer, ByVal y1 As Integer)

        Dim po As Point                         'po点击前鼠标位置
        Dim po1 As Point                        '对调方块1位置
        Dim po2 As Point                        '对调方块2位置
        Dim kX As Integer                       '方块1的绝对X坐标
        Dim kY As Integer                       '方块1的绝对Y坐标
        Dim kX1 As Integer                      '方块2的绝对X坐标
        Dim kY1 As Integer                      '方块2的绝对Y坐标
        Dim winRECT As Rectangle                '游戏窗口的RECT

        '获得游戏窗口的RECT
        GetWindowRect(g_WindowHwnd, winRECT)

        '绝对坐标 = 游戏窗口左上角坐标 + 游戏中的相对坐标
        kX = winRECT.Left + x
        kY = winRECT.Top + y

        kX1 = winRECT.Left + x1
        kY1 = winRECT.Top + y1

        po1.X = kX
        po1.Y = kY
        po2.X = kX1
        po2.Y = kY1

        ''模拟鼠标按下弹起

        If bolPrompt = True Then

            Dim WindowDC As Integer
            WindowDC = GetDC(g_WindowHwnd)

            Dim p As RECT
            p.Bottom = po1.X
            p.Top = po1.Y
            p.Left = po2.X
            p.Right = po2.Y

            Dim l As Integer
            l = CreateSolidBrush(&H0)

            FillRect(WindowDC, p, l)

        Else

            '获得鼠标点击前位置
            GetCursorPos(po)

            '将鼠标移动到指定位置
            SetCursorPos(po1)

            '模拟鼠标按下弹起
            mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
            SetCursorPos(po2)
            mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

            '点击后返回原先位置
            SetCursorPos(po)

        End If

    End Sub

#End Region

#Region " 执行一次消除 "

    Public Sub KillBox()

        Dim i As Integer
        Dim j As Integer

        GetBoxs()

        '1情况
        For i = 0 To 4
            For j = 0 To 7
                If Boxs(i, j).type = Boxs(i + 2, j).type And Boxs(i, j).type = Boxs(i + 3, j).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i + 1, j).x, Boxs(i + 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '2情况
        For i = 0 To 5
            For j = 0 To 6
                If Boxs(i, j).type = Boxs(i + 2, j + 1).type And Boxs(i, j).type = Boxs(i + 1, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j + 1).x, Boxs(i, j + 1).y)
                    Exit Sub
                End If
            Next j
        Next i

        '3情况
        For i = 0 To 5
            For j = 1 To 7
                If Boxs(i, j).type = Boxs(i + 2, j - 1).type And Boxs(i, j).type = Boxs(i + 1, j - 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j - 1).x, Boxs(i, j - 1).y)
                    Exit Sub
                End If
            Next j
        Next i

        '4情况
        For i = 3 To 7
            For j = 0 To 7
                If Boxs(i, j).type = Boxs(i - 2, j).type And Boxs(i, j).type = Boxs(i - 3, j).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i - 1, j).x, Boxs(i - 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '5情况
        For i = 2 To 7
            For j = 0 To 6
                If Boxs(i, j).type = Boxs(i - 1, j + 1).type And Boxs(i, j).type = Boxs(i - 2, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j + 1).x, Boxs(i, j + 1).y)
                    Exit Sub
                End If
            Next j
        Next i

        '6情况
        For i = 2 To 7
            For j = 1 To 7
                If Boxs(i, j).type = Boxs(i - 1, j - 1).type And Boxs(i, j).type = Boxs(i - 2, j - 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j - 1).x, Boxs(i, j - 1).y)
                    Exit Sub
                End If
            Next j
        Next i

        '7情况
        For i = 1 To 7
            For j = 0 To 5

                If Boxs(i, j).type = Boxs(i - 1, j + 2).type And Boxs(i, j).type = Boxs(i - 1, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i - 1, j).x, Boxs(i - 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '8情况
        For i = 0 To 6
            For j = 0 To 5

                If Boxs(i, j).type = Boxs(i + 1, j + 2).type And Boxs(i, j).type = Boxs(i + 1, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i + 1, j).x, Boxs(i + 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '9情况
        For i = 1 To 7
            For j = 1 To 6

                If Boxs(i, j).type = Boxs(i - 1, j - 1).type And Boxs(i, j).type = Boxs(i - 1, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i - 1, j).x, Boxs(i - 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '10情况
        For i = 0 To 6
            For j = 1 To 6

                If Boxs(i, j).type = Boxs(i + 1, j - 1).type And Boxs(i, j).type = Boxs(i + 1, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i + 1, j).x, Boxs(i + 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '11情况
        For i = 1 To 6
            For j = 1 To 7

                If Boxs(i, j).type = Boxs(i + 1, j - 1).type And Boxs(i, j).type = Boxs(i - 1, j - 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j - 1).x, Boxs(i, j - 1).y)
                    Exit Sub
                End If
            Next j

        Next i

        '12情况
        For i = 1 To 6
            For j = 0 To 6

                If Boxs(i, j).type = Boxs(i + 1, j + 1).type And Boxs(i, j).type = Boxs(i - 1, j + 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j + 1).x, Boxs(i, j + 1).y)
                    Exit Sub
                End If
            Next j
        Next i

        '13情况
        For i = 1 To 7
            For j = 2 To 7

                If Boxs(i, j).type = Boxs(i - 1, j - 2).type And Boxs(i, j).type = Boxs(i - 1, j - 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i - 1, j).x, Boxs(i - 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '14情况
        For i = 0 To 7
            For j = 3 To 7

                If Boxs(i, j).type = Boxs(i, j - 2).type And Boxs(i, j).type = Boxs(i, j - 3).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j - 1).x, Boxs(i, j - 1).y)
                    Exit Sub
                End If
            Next j
        Next i

        '15情况
        For i = 0 To 6
            For j = 2 To 7

                If Boxs(i, j).type = Boxs(i + 1, j - 2).type And Boxs(i, j).type = Boxs(i + 1, j - 1).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i + 1, j).x, Boxs(i + 1, j).y)
                    Exit Sub
                End If
            Next j
        Next i

        '16情况
        For i = 0 To 7
            For j = 0 To 4

                If Boxs(i, j).type = Boxs(i, j + 2).type And Boxs(i, j).type = Boxs(i, j + 3).type Then
                    MouseClick(Boxs(i, j).x, Boxs(i, j).y, Boxs(i, j + 1).x, Boxs(i, j + 1).y)
                    Exit Sub
                End If
            Next j
        Next i

    End Sub

#End Region

End Class

注入DLL下载:
https://files.cnblogs.com/hszfzjd/TWin.rar

以后有时间我会继续完善的!

出处:https://www.cnblogs.com/hszfzjd/archive/2005/11/29/286900.html


相关教程