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 = 0 Then KillBoom = False Exit Function End If Dim pid As Long Dim hp As LongCall GetWindowThreadProcessId(hwnd, pid) hp = OpenProcess(PROCESS_ALL_ACCESS, 0&, pid) Dim total As Long Dim height As Long Dim width As Long Call ReadProcessMemory(hp, ByVal total_addr, ByVal VarPtr(total), 4&, 0&) Call ReadProcessMemory(hp, ByVal height_addr, ByVal VarPtr(height), 4&, 0&) Call ReadProcessMemory(hp, ByVal width_addr, ByVal VarPtr(width), 4&, 0&) Dim size As Long Dim mem() As Byte size = 32 * height + 16 ReDim mem(size) As Byte Call ReadProcessMemory(hp, ByVal area_addr, ByVal VarPtr(mem(0)), size, 0&) Dim i As Long Dim x As Long Dim y As Long For i = 0 To size - 1 '至于为什么这么算,我也忘了,因为写这个代码时候太久远了 '应该是一点点测算出来的 '比如,16是距离窗体左侧的距离 '97是距离窗体上方的距离 x = i Mod 32 y = i \ 32 x = 16 + x * 16 y = 97 + y * 16 - 32 If mem(i) = &H8F Then '如是雷,就插小红旗 Call PostMessage(hwnd, WM_RBUTTONDOWN, 0&, MakeParam(x, y)) Call PostMessage(hwnd, WM_RBUTTONUP, 0&, MakeParam(x, y)) Else '不是雷,就点开它吧 Call PostMessage(hwnd, WM_LBUTTONDOWN, 0&, MakeParam(x, y)) Call PostMessage(hwnd, WM_LBUTTONUP, 0&, 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 = (-4) 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 = 1 '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