前两天网上狂传对对碰游戏外挂的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
以后有时间我会继续完善的！
