VB编写模拟类外挂

1.捕捉坐标，，，---用一个显示坐标的工具
2。了解键盘-鼠标按键代码（代码集合）
3。运行程序后呼叫热键-呼出程序（能在程序中运行，而不是最小化了游戏程序）
4。编写一个窗体（上面有各种按键的控制）
呼叫出窗体后，控制模拟控制各种按键
包括：（1）键盘的任意按键
           （2）鼠标的右击/左击
            （3）鼠标的拖曳
            （4）鼠标的中键控制
5。对游戏程序的了解
（1）游戏的窗体标题或句柄（通过SPY++可以捕捉）
（2）传送消息（各种传送消息的命令，postmessage,send ...)
（3）延迟的处理，对各控制后，延迟效果的把握。

总之：正常自动启动游戏程序，捕捉运行的情况、有效的修改
准确、快捷的传送消息

 

第一坐标捕捉　

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long Const GWL_EXSTYLE = (-20) Const LWA_ALPHA As Long = &H2 Const WS_EX_LAYERED As Long = &H80000 '设置窗体透明的函数 '============================================================= Const HWND_TOPMOST = -1 Const SWP_SHOWWINDOW = &H40 Private Type POINTAPI ' 注释： 声明数据类型 x As Long y As Long End Type Dim z As POINTAPI '注释： 变量 Private Sub Form_Load() Dim retValue As Long retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOW) SetTrans Form1.hwnd, 200 '设置窗体透明的函数 Timer1.Enabled = True Timer1.Interval = 1 End Sub Private Sub Timer1_Timer() GetCursorPos z '注释： 获取坐标 Label1 = "x: " & z.x ' 注释： 显示 x 坐标 Label2 = "y: " & z.y '注释： 显示 y 坐标 End Sub '该方法适用于2000/XP系统,将下面代码放在一个模块中便可，调用时使用： 'SetTrans Form1.hwnd, 100 ' 100为透明度，最大255 Public Sub SetTrans(ByVal hwnd As Long, ByVal Alpha As Integer) Call GetWindowLong(hwnd, GWL_EXSTYLE) Call SetWindowLong(hwnd, GWL_EXSTYLE, preStyle Or WS_EX_LAYERED) '加上一个透明属性 On Error Resume Next Call SetLayeredWindowAttributes(hwnd, 0, Alpha, LWA_ALPHA) End Sub

 

第二热键呼出程序窗口

 

'以下在模块中 Option Explicit Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long 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 Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, _ ByVal fsModifiers As Long, ByVal vk As Long) As Long 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) Public preWinProc As Long Public Modifiers As Long, uVirtKey As Long, idHotKey As Long Private Type taLong ll As Long End Type Private Type t2Int lWord As Integer hword As Integer End Type Public Function wndproc(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.hword = uVirtKey Then '在IF后面移出来的(i2.lWord = Modifiers) And Debug.Print "HotKey Shift-Alt-G Pressed " End If End If End If '将之送往原来的Window Procedure wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam) End Function '以下在 Form Sub Form_Load() Dim ret As Long preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC) ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc) idHotKey = 1 'in the range &h0000 through &hBFFF 'Modifiers = MOD_ALT + MOD_SHIFT '先屏蔽两个组合 试试G键 uVirtKey = vbKeyG ret = RegisterHotKey(Me.hwnd, idHotKey, 0, uVirtKey) '这里把Modifiers改成0 End Sub

 

第三鼠标模拟控制

 

Option Explicit 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 SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '这个是设置鼠标的位置! 'Option_Tag标示选择了哪一种模拟事件 Dim Option_Tag As Integer 'OnTest标示是否处于模拟状态，以便我们停止模拟 Dim OnTest As Boolean '对API变量的定义 Const MOUSEEVENTF_LEFTDOWN = &H2 Const MOUSEEVENTF_LEFTUP = &H4 Const MOUSEEVENTF_MIDDLEDOWN = &H20 Const MOUSEEVENTF_MIDDLEUP = &H40 Const MOUSEEVENTF_MOVE = &H1 Const MOUSEEVENTF_ABSOLUTE = &H8000 Const MOUSEEVENTF_RIGHTDOWN = &H8 Const MOUSEEVENTF_RIGHTUP = &H10 Private Sub Command1_Click() Timer1.Enabled = True End Sub Private Sub Form_Load() Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Call SetCursorPos(152, 272) '让鼠标移动到(600,600) mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 Sleep 2000 Call SetCursorPos(544, 452) '让鼠标移动到(600,600) mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 Sleep 1000 Call SetCursorPos(250, 269) '让鼠标移动到(600,600) mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 Call SetCursorPos(306, 455) '让鼠标移动到(600,600) mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 Call SetCursorPos(545, 454) '让鼠标移动到(600,600) mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 Sleep 18000 End Sub

 

第四鼠标中键模拟

'用API函数mouse_event可以做到 '函数及常数声明: Public 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) Public Const MOUSEEVENTF_ABSOLUTE = &H8000 '' absolute move Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down Public Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up Public Const MOUSEEVENTF_MOVE = &H1 ' mouse move Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up Public Const MOUSEEVENTF_WHEEL = &H800 ' 测试代码:建立一个窗体，加一个按钮和一个timer Option Explicit Private Sub Command1_Click() Timer1.Interval = 5000 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() Dim i As Integer For i = 0 To 100 DoEvents mouse_event MOUSEEVENTF_WHEEL, 0, 0, 10, 0 Next For i = 0 To 100 DoEvents mouse_event MOUSEEVENTF_WHEEL, 0, 0, -10, 0 Next End Sub

 

第五键盘模拟之一-后台发送

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long Const WM_KEYDOWN = &H100 Const WM_KEYUP = &H101 Const WM_CHAR = &H102 Const VK_A = &H41 Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long Dim s As String Dim Firstbyte As String 'lparam参数的24-31位 If flag = WM_KEYDOWN Then '如果是按下键 Firstbyte = "00" Else Firstbyte = "C0" '如果是释放键 End If Dim Scancode As Long '获得键的扫描码 Scancode = MapVirtualKey(VirtualKey, 0) Dim Secondbyte As String 'lparam参数的16-23位，即虚拟键扫描码 Secondbyte = Right("00" & Hex(Scancode), 2) s = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位，即发送次数和其它扩展信息 MakeKeyLparam = Val("&H" & s) End Function Private Sub Command1_Click() Dim hwnd As Long hwnd = 66442 'XXXXX表示记事本编辑框的句柄 注意：这里是10进制的数，用spy+++是十六进制的 要求转换 PostMessage hwnd, WM_KEYDOWN, VK_A, MakeKeyLparam(VK_A, WM_KEYDOWN) ''按下A键 PostMessage hwnd, WM_CHAR, Asc("A"), MakeKeyLparam(VK_A, WM_KEYDOWN) '输入字符A PostMessage hwnd, WM_UP, VK_A, MakeKeyLparam(VK_A, WM_UP) '释放A键 End Sub

 

 

 

第六键盘模拟之二--前台发送

Private Sub Command1_Click() Dim returnvalue Form1.Hide returnvalue = Shell("c:/windows/system32/calc.exe", 1) AppActivate returnvalue SendKeys "12345" SendKeys "{+}" SendKeys "34" SendKeys "=" SendKeys "{+}" SendKeys "678" SendKeys "=" SendKeys "*" SendKeys "3" SendKeys "/" SendKeys "678" SendKeys "*" SendKeys "35" SendKeys "=" SendKeys "{DEL}" SendKeys "678" SendKeys "/" SendKeys "35" SendKeys "=" End Sub

 

第七--键盘模拟之三-驱动级发送

'模块中 Declare Function MapPhysToLin Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long Declare Function UnmapPhysicalMemory Lib "WinIo.dll" (ByVal PhysMemHandle, ByVal LinAddr) As Boolean Declare Function GetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean Declare Function SetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean Declare Function InitializeWinIo Lib "WinIo.dll" () As Boolean Declare Function ShutdownWinIo Lib "WinIo.dll" () As Boolean Declare Function InstallWinIoDriver Lib "WinIo.dll" (ByVal DriverPath As String, ByVal Mode As Integer) As Boolean Declare Function RemoveWinIoDriver Lib "WinIo.dll" () As Boolean ' ------------------------------------以上是WINIO函数声明------------------------------------------- Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long '-----------------------------------以上是WIN32 API函数声明----------------------------------------- '然后再添加如下过程，这2个过程用来模拟按键： Const KBC_KEY_CMD = &H64 '键盘命令端口 Const KBC_KEY_DATA = &H60 '键盘数据端口 '再添加下面这个过程: Sub KBCWait4IBE() '等待键盘缓冲区为空 Dim dwVal As Long Do GetPortVal &H64, dwVal, 1 '这句表示从&H64端口读取一个字节并把读出的数据放到变量dwVal中 'GetPortVal函数的用法是GetPortVal 端口号,存放读出数据的变量,读入的长度 Loop While (dwVal And &H2) End Sub '上面的是一个根据KBC规范写的过程，它的作用是在向键盘端口写入数据前等待一段时间，后面将会用到。 Sub MyKeyDown(ByVal vKeyCoad As Long) '这个用来模拟按下键，参数vKeyCoad传入按键的虚拟码 Dim btScancode As Long btScancode = MapVirtualKey(vKeyCoad, 0) KBCWait4IBE '发送数据前应该先等待键盘缓冲区为空 SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令 'SetPortVal函数用于向端口写入数据，它的用法是SetPortVal 端口号,欲写入的数据，写入数据的长度 KBCWait4IBE SetPortVal KBC_KEY_DATA, btScancode, 1 '写入按键信息,按下键 End Sub Sub MyKeyUp(ByVal vKeyCoad As Long) '这个用来模拟释放键，参数vKeyCoad传入按键的虚拟码 Dim btScancode As Long btScancode = MapVirtualKey(vKeyCoad, 0) KBCWait4IBE '等待键盘缓冲区为空 SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令 KBCWait4IBE SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息，释放键 End Sub Private Sub Form_Load() If InitializeWinIo = False Then '用InitializeWinIo函数加载驱动程序，如果成功会返回true，否则返回false MsgBox "驱动程序加载失败!" Unload Me End If Timer1.Interval = 3000 Timer1.Enabled = True End Sub '窗体中 Private Sub Form_Unload(Cancel As Integer) ShutdownWinIo '程序结束时记得用ShutdownWinIo函数卸载驱动程序 End Sub Private Sub Timer1_Timer() Dim VK_A As Long VK_A = &H41 MyKeyDown VK_A MyKeyUp VK_A '模拟按下并释放A键 End Sub '备注：此程序调试的时候是不能加载WINIO。DALL 不知道是不是在 window XP下 Debug不能访问端口还是什么 '生成exe文件时候 可以运行。 '同时注意。这个winio驱动是唯一的.无法几个程序同时加载. '同时，由于其访问的是端口，不能向特定的窗口发送消息---- 只要是当前的窗体就会会发送。　 '一般用这个驱动的用来做外挂的多（本人还没想到想指定窗体发送的方法）

第八--后台模拟发送鼠标事件

............................
正在研究中
。。。。。。。。。
希望能有所突破