cSystemHook.cls

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