VB6之扫雷克星

很久之前，那时候我还不太会玩（现在也不厉害）扫雷这个游戏，同学总在我面前炫耀自己的技术有多叼。“高级，99颗雷，只需三分钟。。。”，如此这般。也许确实需要天赋，我总要排查个半天才敢点下左键，然后就BOOM！

偶然一天，在网上浏览网页看到了一篇关于“扫雷外挂”的文章，记得那个人是用汇编写的，没记错的话应该是MASM32。文章大概意思是雷的布局是有标志的，雷区内目标值为0x8F的就是雷。要想找到所有雷的坐标，前提是先找到雷区的边界，即起始点、宽度和长度。如果不会反汇编（最起码能看懂二进制码），恐怕很难搞清楚。幸运的是那个高手就是这样的：他提供了雷区的基址。我这样的菜手只好拾人牙慧，拿来改改，用VB6实现了个“扫雷克星”。

注意：雷区的分布应该是在你点击第一下之后才确立的，所以玩的时候先打开扫雷随便点一个，再使用“扫雷克星”。

原理很简单，就不在赘述了，直接上代码：

'_killboom.bas
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
    lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, _
    lpBaseAddress As Any, _
    lpBuffer As Any, _
    ByVal nSize As Long, _
    lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
    ByVal hdc As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
'这些既是雷区的基址
Private Const total_addr = &H10056A4
Private Const height_addr = &H10056A8
Private Const width_addr = &H10056AC
Private Const area_addr = &H1005361
 
Public Function KillBoom() As Boolean
    '这个就是驱雷的函数了，废话 o.O!!
    Dim hwnd As Long
 
    hwnd = FindWindow("扫雷", vbNullString)
    If hwnd =  Then
        KillBoom = False
        Exit Function
    End If
 
    Dim pid As Long
    Dim hp As LongCall GetWindowThreadProcessId(hwnd, pid)
    hp = OpenProcess(PROCESS_ALL_ACCESS, &, pid)
 
    Dim total As Long
    Dim height As Long
    Dim width As Long
 
    Call ReadProcessMemory(hp, ByVal total_addr, ByVal VarPtr(total), &, &)
    Call ReadProcessMemory(hp, ByVal height_addr, ByVal VarPtr(height), &, &)
    Call ReadProcessMemory(hp, ByVal width_addr, ByVal VarPtr(width), &, &)
 
    Dim size As Long
    Dim mem() As Byte
 
    size =  * height +
    ReDim mem(size) As Byte
    Call ReadProcessMemory(hp, ByVal area_addr, ByVal VarPtr(mem()), size, &)
 
    Dim i As Long
    Dim x As Long
    Dim y As Long
 
    For i =  To size -
    '至于为什么这么算，我也忘了，因为写这个代码时候太久远了
    '应该是一点点测算出来的
    '比如，16是距离窗体左侧的距离
    '97是距离窗体上方的距离
        x = i Mod
        y = i \ 
 
        x =  + x *
        y =  + y *  -
        If mem(i) = &H8F Then
            '如是雷，就插小红旗
            Call PostMessage(hwnd, WM_RBUTTONDOWN, &, MakeParam(x, y))
            Call PostMessage(hwnd, WM_RBUTTONUP, &, MakeParam(x, y))
        Else
            '不是雷，就点开它吧
            Call PostMessage(hwnd, WM_LBUTTONDOWN, &, MakeParam(x, y))
            Call PostMessage(hwnd, WM_LBUTTONUP, &, MakeParam(x, y))
        End If
    Next
 
    Erase mem
    Call CloseHandle(hp)Call SetForegroundWindow(hwnd)
    KillBoom = True
End Function
 
Private Function MakeParam(ByVal LoWord As Long, ByVal HiWord As Long) As Long
  MakeParam = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function

为了更优雅些，再加上热键。这样玩的时候，输入快捷键（Alt+Shift+K）就秒杀，哈哈（略邪恶）：

'_hotkey.bas
'这个模块就是在网上找到，链接如下
'@http://www.cnblogs.com/rosesmall/archive/2012/09/19/2693707.html
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, _
    ByVal id As Long, _
    ByVal fskey_Modifiers As Long, _
    ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
 
Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-)
Private Type taLong
   ll As Long
End Type
Private Type t2Int
   lWord As Integer
   hword As Integer
End Type
 
Public preWinProc As Long
Public Modifiers As Long, uVirtKey As Long, idHotKey As Long
 
Public Function CallbackWndproc(ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    If Msg = WM_HOTKEY Then
       If wParam = idHotKey Then
         Dim lp As taLong, i2 As t2Int
         lp.ll = lParam
         LSet i2 = lp
         If (i2.lWord = Modifiers) And i2.hword = uVirtKey Then
            Call KillBoom
         End If
       End If
    End If
    CallbackWndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

最后是窗体部分，注册热键然后隐藏自己：

Private Sub Form_Load()
'this code refered from following link
'@http://www.cnblogs.com/rosesmall/archive/2012/09/19/2693707.html
    preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf CallbackWndproc)
    idHotKey =  'in the range &h0000 through &hBFFF
    Modifiers = MOD_ALT + MOD_SHIFT
    uVirtKey = vbKeyK
    Call RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)
    Call Me.Hide
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
    Call UnregisterHotKey(Me.hwnd, uVirtKey)
End Sub

搞定收工！另外，那个汇编大神请原谅我，因为实在记不清你文章的网址了，这里就没法贴出来了。

贴张图炫耀下：

终于能打败我同学了，可惜我已经毕业了。。。

PS：差点忘了，最好还是另外注册个热键（如Alt+Shift+Q）关闭自己，否则窗体隐藏了你也许会忘掉它的存在。我因为是在调试模式下，所以不需要 Orz