cSystemHook.cls

本文介绍了一个使用VBScript实现的全局钩子示例,该示例通过设置全局钩子来捕获键盘和鼠标事件。文章详细展示了如何声明Windows API函数、定义事件处理过程以及如何安装和移除钩子。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

Option Explicit Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Public Event KeyDown(KeyCode As Integer, Shift As Integer) Public Event KeyUp(KeyCode As Integer, Shift As Integer) Public Event SystemKeyDown(KeyCode As Integer) Public Event SystemKeyUp(KeyCode As Integer) 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 Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long) Private Const WM_KEYDOWN = &H100 Private Const WM_KEYUP = &H101 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_MBUTTONDOWN = &H207 Private Const WM_MBUTTONUP = &H208 Private Const WM_MBUTTONDBLCLK = &H209 Private Const WM_MOUSEWHEEL = &H20A Private Const WM_SYSTEMKEYDOWN = &H104 Private Const WM_SYSTEMKEYUP = &H105 Private Const WH_JOURNALRECORD = 0 Private Const WH_GETMESSAGE = 3 Private Type EVENTMSG wMsg As Long lParamLow As Long lParamHigh As Long msgTime As Long hWndMsg As Long End Type Dim EMSG As EVENTMSG Public Function SetHook() As Boolean If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, App.hInstance, 0) If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID) SetHook = True End Function Public Sub RemoveHook() UnhookWindowsHookEx hAppHook UnhookWindowsHookEx hJournalHook hAppHook = 0 hJournalHook = 0 End Sub Private Sub Class_Initialize() SHptr = ObjPtr(Me) End Sub Private Sub Class_Terminate() If hJournalHook Or hAppHook Then RemoveHook End Sub Friend Function FireEvent(ByVal lParam As Long) Dim i%, j%, k% Dim s As String If lParam = WM_CANCELJOURNAL Then hJournalHook = 0 SetHook Exit Function End If CopyMemory EMSG, ByVal lParam, Len(EMSG) Select Case EMSG.wMsg Case WM_KEYDOWN j = 0 If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) RaiseEvent KeyDown(k, j) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_KEYUP j = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) RaiseEvent KeyUp(k, j) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_MOUSEMOVE i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyLButton) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyRButton) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMButton) Then i = (i Or 4) 'fixed by JJ j = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4) 'fixed by JJ RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP i = 0 'fixed by JJ If GetAsyncKeyState(vbKeyShift) Then i = (i Or 1) 'fixed by JJ If GetAsyncKeyState(vbKeyControl) Then i = (i Or 2) 'fixed by JJ If GetAsyncKeyState(vbKeyMenu) Then i = (i Or 4) 'fixed by JJ RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh)) Case WM_SYSTEMKEYDOWN s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case WM_SYSTEMKEYUP s = Hex(EMSG.lParamLow) k = (EMSG.lParamLow And &HFF) If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k) s = Left$(s, 2) & Right$("00" & Hex(k), 2) 'fixed by JJ EMSG.lParamLow = CLng("&h" & s) CopyMemory ByVal lParam, EMSG, Len(EMSG) Case Else End Select End Function Public Property Get HookState() As Boolean If hAppHook = 0 Then HookState = False Else HookState = True End If End Property
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值