最近论坛中老是提全局键盘、鼠标HOOK问题，可做这个东西很容易引导“犯罪”，我今天提供的源码希望不要用于“木马”之类的用途。
一、新建一个ActiveX Dll工程，名字栏里取名为SysHook
二、添加一个模块，取名为mHook，添加代码如下：
Option Explicit
Type POINTAPI
x As Long
y As Long
End Type
Type TMSG
hwnd As Long
message As Long
wParam As Long
mousemove是什么键lParam As Long
time As Long
pt As POINTAPI
End Type
public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
public hJournalHook As Long, hAppHook As Long
Public SHptr As Long
Public Const WM_CANCELJOURNAL = &H4B
<br><br><br>Public Function JournalRecordProc(ByVal nCode As Long, ByVal wParam As Long, By
Val lParam As Long) As Long<br> If nCode < 0 Then<br> JournalRecordProc = CallNextHookEx(hJournalHook, nCode, wParam, lParam)<br> Exit Function<br> End If<br> ResolvePointer(SHptr).FireEvent lParam<br> Call CallNextHookEx(hJournalHook, nCode, wParam, lParam)<br>End Function
<br><br><br>Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long<br> If nCode < 0 Then<br> AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam)<br> Exit Function<br> End If<br> Dim msg As TMSG<br> CopyMemory msg, ByVal lParam, Len(msg)<br> Select ssage<br> Case WM_CANCELJOURNAL<br> If wParam = 1 Then ResolvePointer(SHptr).FireEvent WM_CANCELJOURNAL<br> End Select<br> Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam)<br>End Function
<br><br><br>Private Function ResolvePointer(ByVal lpObj&) As cSystemHook<br> Dim oSH As cSystemHook<br> CopyMemory oSH, lpObj, 4&<br> Set ResolvePointer = oSH<br> CopyMemory oSH, 0&, 4&<br>End Function
<br><br><br>三、把工程自动建立的Class1类模块改名为cSystemHook，添加代码如下：
<br><br><br>Option Explicit<br>Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)<br>Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)<br>Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)<br>Public Event KeyDown(KeyCode As Integer, Shift As Integer)<br>Public Event KeyUp(KeyCode As Integer, Shift As Integer)<br>Public Event SystemKeyDown(KeyCode As Integer)<br>Public Event SystemKeyUp(KeyCode As Integer)
<br><br><br>Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long<br>Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long<br>Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
<br><br><br>Private Const WM_KEYDOWN = &a
mp;H100<br>Private Const WM_KEYUP = &H101<br>Private Const WM_MOUSEMOVE = &H200<br>Private Const WM_LBUTTONDOWN = &H201<br>Private Const WM_LBUTTONUP = &H202<br>Private Const WM_LBUTTONDBLCLK = &H203<br>Private Const WM_RBUTTONDOW
N = &H204<br>Private Const WM_RBUTTONUP = &H205<br>Private Const WM_RBUTTONDBLCLK = &H206<br>Private Const WM_MBUTTONDOWN = &H207<br>Private Const WM_MBUTTONUP = &H208<br>Private Const WM_MBUTTONDBLCLK = &H209<br>Private Const WM_MOUSEWHEEL = &H20A<br>Private Const WM_SYSTEMKEYDOWN = &H104<br>Private Const WM_SYSTEMKEYUP = &H105
<br><br><br>Private Const WH_JOURNALRECORD = 0<br>Private Const WH_GETMESSAGE = 3
<br><br><br>Private Type EVENTMSG<br> wMsg As Long<br> lParamLow As Long<br> lParamHigh As Long<br> msgTime As Long<br> hWndMsg As Long<br>End Type
<br><br><br>Dim EMSG As EVENTMSG
<br><br><br>Public Function SetHook() As Boolean<br> If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, App.hInstance, 0)<br> If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID)<br> SetHook = True<br>End Function
<br><br><br>Public Sub RemoveHook()<br> UnhookWindowsHookEx hAppHook<br> UnhookWindowsHookEx hJournalHook<br>End Sub
<br><br><br>Private Sub Class_Initialize()<br> SHptr = ObjPtr(Me)<br>End Sub
<br><br><br>Private Sub Class_Terminate()<br> If hJournalHook Or hAppHook Then RemoveHook<br>End Sub
<br><br><br>Friend Function FireEvent(ByVal lParam As Long)<br> Dim i%, j%, k%<br> Dim s As String<br> If lParam = WM_CANCELJOURNAL Then<br> hJournalHook = 0<br> SetHook<br> Exit Function<br> End If<br> <br> CopyMemory EMSG, ByVal lParam, Len(EMSG)<br> Select Case EMSG.wMsg<br> Case WM_KEYDOWN<br> j = 0<br> If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ<br> s = Hex(EMSG.lParamLow)<br> k = (EMSG.lParamLow And &HFF)<br> RaiseEvent KeyDown(k, j)<br> s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ<br> EMSG.lParamLow = CLng("&h" & s)<br> CopyMemory ByVal lParam, EMSG, Len(EMSG)<br> Case WM_KEYUP<br> j = 0 'fixed by JJ<br> If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ<br> s = Hex(EMSG.lParamLow)<br> k = (EMSG.lParamLow And &HFF)<br> RaiseEvent KeyUp(k, j)<br> s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ<br> EMSG.lParamLow = CLng("&h" & s)<
br> CopyMemory ByVal lParam, EMSG, Len(EMSG)<br> Case WM_MOUSEMOVE<br> i = 0 'fixed by JJ<br> If GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyRButton) Then i = (i Or 2) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyMButton) Then i = (i Or
4) 'fixed by JJ<br> j = 0 'fixed by JJ<br> If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ<br> RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))<br> Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN<br> i = 0 'fixed by JJ<br> If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ<br> RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))<br> Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP<br> i = 0 'fixed by JJ<br> If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ<br> If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ<br> RaiseEvent MouseUp(2 ^ ((EMSG.
wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))<br> Case WM_SYSTEMKEYDOWN<br> s = Hex(EMSG.lParamLow)<br> k = (EMSG.lParamLow And &HFF)<br> If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k)<br> s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ<br> EMSG.lParamLow = CLng("&h" & s)<br> CopyMemory ByVal lParam, EMSG, Len(EMSG)<br> Case WM_SYSTEMKEYUP<br> s = Hex(EMSG.lParamLow)<br> k = (EMSG.lParamLow And &HFF)<br> If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k)<br> s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ<br> EMSG.lParamLow = CLng("&h" & s)<br> CopyMemory ByVal lParam, EMSG, Len(EMSG)<br> Case Else<br> End Select<br>End Function<br>
<br><br><br>四、千万别望了保存（否则你要后悔的），编译生成DLL，然后可以测试了，做一个普通的工程，添加引用SysHook，在窗体中添加测试代码（嘿嘿，可能你会吃点苦头）：
<br><br><br>Option Explicit<br>Dim WithEvents sh As cSystemHook
<br><br><br>Private Sub Form_Load()<br> Set sh = New cSystemHook<br> sh.SetHook<br>End Sub
<br><br><br>Private Sub Form_Unload(Cancel As Integer)<br> sh.RemoveHook<br> Set sh = Nothi
ng<br>End Sub
<br><br><br>Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)<br> If Button = 1 Then<br> MsgBox "你按了左键"<br> End If<br> If Button = 2 Then<br> MsgBox "你按了右键"<br> End If<br>End Sub<br>
<br><br><br>五、接着你可以试试全局的下列事件（记住刚才的教训，可要小心哦）：
<br><br><br><br>Private Sub sh_KeyDown(KeyCode As Integer, Shift As Integer)
<br><br><br>End Sub
<br><br><br>Private Sub sh_KeyUp(KeyCode As Integer, Shift As Integer)
<br><br><br>End Sub
<br><br><br>MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
<br><br><br>End Sub
<br><br><br>Private Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
<br><br><br
>End Sub
<br><br><br>Private Sub sh_SystemKeyDown(KeyCode As Integer)
<br><br><br>End Sub
<br><br><br>Private Sub sh_SystemKeyUp(KeyCode As Integer)
<br><br><br>End Sub<br>
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论