modmain.bas

91.com小游戏“水果“（对对碰）的外挂源码

Attribute VB_Name = "modMain"
'*************模块:modMain******************
'作者:Cyril
'Email:[e-mail]
'Web: http://www.sguca.com/other
'书写日期:2004.10.23
'编辑日期:2002.10.23
'转载请保留此信息
'版权所有 （a） Cyril 405 工作室
'********************************************


Option Explicit

'API声明
Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowPos Lib "USER32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Sub mouse_event Lib "USER32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "USER32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long

'API类型定义
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public kkX As Long                                       '方块的绝对X坐标
   Public kkY As Long
'方块类型定义
Public Enum BOX_TYPE
Ox = 0
Dog = 1
Panda = 2
Chicken = 3
Cat = 4
Frog = 5
Monkey = 6
Putao = 7
End Enum

'自定义方块数据类型x,y位方块坐标,type为方块类型.
'在Easy对对碰1.5版中还加如了一些其他属性,例如是否带道具属性.
Public Type BOX
    x As Integer
    y As Integer
    type As BOX_TYPE
    End Type
    
    'Api常量
    
    '鼠标事件常量
    Private Const MOUSEEVENTF_LEFTDOWN = &H2
    Private Const MOUSEEVENTF_LEFTUP = &H4
    Private Const MOUSEEVENTF_MOVE = &H1
    Private Const MOUSEEVENTF_ABSOLUTE = &H8000
    
    Public Const HWND_TOPMOST = -1
    Public Const SWP_NOSIZE = &H1
    Public Const SWP_NOMOVE = &H2
    '自定义常量
    '游戏区左上角坐标
    Public Const GAME_LEFT As Integer = 67
    Public Const GAME_TOP As Integer = 162
    '每个方块的长宽
    Const BOX_WIDTH As Integer = 40
    Const BOX_HEIGHT As Integer = 40
    
    '游戏窗口句柄
    Public g_WindowHwnd As Long
    
    Public shuiguox(8) As Long
    Public shuiguoy(8) As Long

    '方块矩阵 (8*8)boxs(7,7) ;(9*8)
    Public boxs(8, 7) As BOX
    
'**********过程名:DelayTime******************
'作者:Cyril
'书写日期:2004.10.23
'编辑日期:2002.10.23
'目的:获取当前场景 , 建立方块矩阵
'方法:killBox
'应用于:MainMod模块
'********************************************
Public Function getBoxs()
    Dim i As Integer                            '矩阵行
    Dim j As Integer                            '矩阵列
    Dim color1 As Long                          '颜色 (22,22)处
    Dim color2 As Long                          '颜色 (22,17)处
    
    
    
    For i = 0 To 8
        For j = 0 To 7
            With boxs(i, j)
            .x = GAME_LEFT + 10 + BOX_WIDTH * j
            .y = GAME_TOP + 10 + BOX_HEIGHT * i
            '取每个方块坐标(22,22)和(22,17)位置的颜色
            color1 = getColor(.x, .y)
            color2 = getColor(.x, .y - 5)
            
            '用两点颜色确定一个方块类型.
            If color1 = shuiguox(0) And color2 = shuiguoy(0) Then .type = Ox '桃子 5433178,5915119
            If color1 = shuiguox(1) And color2 = shuiguoy(1) Then .type = Chicken '西瓜 5927168,4882944
            If color1 = shuiguox(2) And color2 = shuiguoy(2) Then .type = Dog '绿色茄子 26929,37458
            If color1 = shuiguox(3) And color2 = shuiguoy(3) Then .type = Panda '草莓 16,5334
            If color1 = shuiguox(4) And color2 = shuiguoy(4) Then .type = Cat '蓝色葡萄 15155489,16746058
            
            If color1 = shuiguox(5) And color2 = shuiguoy(5) Then .type = Monkey '香蕉 4112,5432311
            If color1 = shuiguox(6) And color2 = shuiguoy(6) Then .type = Frog '苹果 198,239
            If color1 = shuiguox(7) And color2 = shuiguoy(7) Then .type = Putao '紫色葡萄 13505717,11339916
            End With
        Next j
    Next i

End Function
    
'为了方便理解，这里用了一种比较简单的算法 -- 穷举法.(这也是Easy对对碰最初版本的算法).
'其主要思想是列举16种消除方块的可能。一旦有匹配的情况出现,则马上执行鼠标点击动作.
'如果你要使你的外挂更强大,就必须采更优秀的算法.

'**********过程名:DelayTime******************
'作者:Cyril
'书写日期:2004.10.23
'编辑日期:2002.10.23
'目的:消去一个方块
'方法:killBox
'说明:无
'返回值:无
'应用于:MainMod模块
'********************************************
Public Function killBox()
    Dim i As Integer
    Dim j As Integer
    getBoxs
    
    ' :
    ' |  情况
    '------
    'x
    '.
    'x
    'x
    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
            'MsgBox boxs(i, j).type & "," & boxs(i + 2, j).type & "," & boxs(i + 3, j).type

                            mouseClick boxs(i, j).x, boxs(i, j).y
                mouseClick boxs(i + 1, j).x, boxs(i + 1, j).y
              
                Exit Function
            End If
        Next j
    Next i
    
    '_
    ' |  情况
    
    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
                mouseClick boxs(i, j + 1).x, boxs(i, j + 1).y
                      ' MsgBox "2"
                Exit Function
            End If
        Next j
    Next i
    
    ' _
    '|  情况
    
    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
                mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
                Exit Function
            End If
        Next j
    Next i
    
    '|
    ': 情况
    For i = 3 To 8
        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
                mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
                Exit Function
            End If
        Next j
    Next i
    
    '_ | 情况
    For i = 2 To 8
        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
                mouseClick boxs(i, j + 1).x, boxs(i, j + 1).y
                Exit Function
            End If
        Next j
    Next i
    
    '| _ 情况
    For i = 2 To 8
        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
                mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
                Exit Function
            End If
        Next j
    Next i
    
    '_-- 情况
    For i = 1 To 8
        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
                mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
                Exit Function
            End If
        Next j
    Next i
    
    '-_ _ 情况
    For i = 0 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
                mouseClick boxs(i + 1, j).x, boxs(i + 1, j).y
                Exit Function
            End If
        Next j
    Next i
    
    '   -_- 情况
    For i = 1 To 8
        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
                mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
                Exit Function
            End If
        Next j
    Next i
    '   _-_ 情况
    For i = 0 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
                mouseClick boxs(i + 1, j).x, boxs(i + 1, j).y
                Exit Function
            End If
        Next j
    Next i
    
    '|< 情况
    
    For i = 1 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 - 1, j - 1).type Then
                mouseClick boxs(i, j).x, boxs(i, j).y
                mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
                Exit Function
            End If
        Next j
        
    Next i
    '>| 情况
    For i = 1 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 - 1, j + 1).type Then
                mouseClick boxs(i, j).x, boxs(i, j).y
                mouseClick boxs(i, j + 1).x, boxs(i, j + 1).y
                Exit Function
            End If
        Next j
    Next i
    '--_ 情况
    
    For i = 1 To 8
        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
                mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
                Exit Function
            End If
        Next j
    Next i
    '-- - 情况
    For i = 0 To 8
        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
                mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
                Exit Function
            End If
        Next j
    Next i
    '_ _-  情况
    For i = 0 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
                mouseClick boxs(i + 1, j).x, boxs(i + 1, j).y
                Exit Function
            End If
        Next j
    Next i
    
    '- -- 情况
    For i = 0 To 8
        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
                mouseClick boxs(i, j + 1).x, boxs(i, j + 1).y
                Exit Function
            End If
        Next j
    Next i
    
End Function
    
'这里的鼠标模拟用了鼠标事件.你也可以用sendmessage来实现.

'**********过程名:DelayTime******************
'作者:Cyril
'书写日期:2004.10.23
'编辑日期:2002.10.23
'目的:模拟鼠标单击
'方法:mouseClick(ByVal x As Long, ByVal y As Long)
'说明:x -- 方块相对游戏窗口的X; y -- 方块相对游戏窗口的Y;
'返回值:无
'应用于:MainMod模块
'********************************************
Public Sub mouseClick(ByVal x As Long, ByVal y As Long)
    Dim po As POINTAPI                                  'po点击前鼠标位置
    Dim kX As Long                                      '方块的绝对X坐标
    Dim kY As Long                                      '方块的绝对Y坐标
    Dim winRECT As RECT                                 '游戏窗口的RECT
    
    '获得游戏窗口的RECT
    GetWindowRect g_WindowHwnd, winRECT
    '绝对坐标 = 游戏窗口左上角坐标 + 游戏中的相对坐标
    kX = winRECT.Left + x
    kY = winRECT.Top + y
    '获得鼠标点击前位置
    GetCursorPos po
    '模拟鼠标移动
    mouse_event MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE, kX * 65535 / 1024, kY * 65535 / 768, 0&, 0&
    '模拟鼠标按下弹起
    
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0&, 0&
    '点击后返回原先位置
   SetCursorPos po.x, po.y
End Sub

    Public Sub mouseClick2()
    Dim po As POINTAPI                                  'po点击前鼠标位置
    Dim kX As Long                                      '方块的绝对X坐标
    Dim kY As Long                                      '方块的绝对Y坐标
    Dim winRECT As RECT                                 '游戏窗口的RECT
    
    '获得游戏窗口的RECT
    GetWindowRect g_WindowHwnd, winRECT
    '绝对坐标 = 游戏窗口左上角坐标 + 游戏中的相对坐标
    kX = winRECT.Left + 590 '按钮x坐标
    kY = winRECT.Top + 465 '按钮y坐标
    '获得鼠标点击前位置
    GetCursorPos po
    '模拟鼠标移动
    mouse_event MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE, kX * 65535 / 1024, kY * 65535 / 768, 0&, 0&
    '模拟鼠标按下弹起
    
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0&, 0&
    '点击后返回原先位置
   SetCursorPos po.x, po.y
End Sub
'**********过程名:DelayTime******************
'作者:Cyril
'书写日期:2004.10.23
'编辑日期:2002.10.23
'目的:取游戏中某点颜色
'方法:getColor(ByVal newX As Long, ByVal newY As Long) As Long
'说明:newX -- 要取颜色的点的X; newY -- 要取颜色的点的Y;(X,Y均相对于游戏窗口)
'返回值:Long
'应用于:MainMod模块
'********************************************
Public Function getColor(ByVal newX As Long, ByVal newY As Long) As Long
    Dim windowDC As Long
    '获取游戏场景
    windowDC = GetDC(g_WindowHwnd)
    '取场景中 (newX,newY)坐标的颜色
    getColor = GetPixel(windowDC, newX, newY)
    '释放场景
    ReleaseDC g_WindowHwnd, windowDC
End Function