It may make you dizzy, but as long as you know VB knowledge and want this thing, you have to study it carefully.
modHook.bas
Option Explicit
Public Declare Function CallNextHookEx Lib user32.dll (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Sub CopyMemory Lib kernel32 Alias RtlMoveMemory (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Public Declare Sub keybd_event Lib user32 (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Datas() As String
Public NUM As Long
Public OldHook As Long
Public LngClsPtr As Long
Public Function BackHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
If nCode < 0 Then
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
Exit Function
End If
ResolvePointer(LngClsPtr).RiseEvent (lparam)
Call CallNextHookEx(OldHook, nCode, wParam, lparam)
End Function
Private Function ResolvePointer(ByVal lpObj As Long) As ClsHook
Dim oSH As ClsHook
CopyMemory oSH, lpObj, 4&
Set ResolvePointer = oSH
CopyMemory oSH, 0&, 4&
End Function
ClsHook.cls
Option Explicit
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Private Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
msgTime As Long
hWndMsg As Long
End Type
Private Const WH_JOURNALRECORD = 0
Private Const WM_KEYDOWN = &H100
Private Declare Function SetWindowsHookEx Lib user32.dll 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.dll (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState Lib user32.dll (ByVal vKey As Long) As Integer
Public Sub SetHook()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
End Sub
Public Sub UnHook()
Call UnhookWindowsHookEx(OldHook)
End Sub
Friend Function RiseEvent(ByVal lparam As Long) As Long
Dim Msg As EVENTMSG
Dim IntShift As Integer
Dim IntCode As Integer
CopyMemory Msg, ByVal lparam, Len(Msg)
IntShift = 0
Select Case Msg.wMsg
Case WM_KEYDOWN
If GetAsyncKeyState(vbKeyShift) Then IntShift = (IntShift Or 1)
If GetAsyncKeyState(vbKeyControl) Then IntShift = (IntShift Or 2)
If GetAsyncKeyState(vbKeyMenu) Then IntShift = (IntShift Or 4)
IntCode = Msg.lParamLow And &HFF
Debug.Print Msg.lParamLow
Debug.Print &HFF
RaiseEvent KeyDown(IntCode, IntShift)
End Select
End Function
Private Sub Class_Initialize()
LngClsPtr = ObjPtr(Me)
End Sub
form1.frm
Option Explicit
Dim WithEvents Hook As ClsHook
Private Declare Function MapVirtualKeyEx Lib user32 Alias MapVirtualKeyExA (ByVal uCode As Long, ByVal uMapType As Long, ByVal dwhkl As Long) As Long
Private Declare Function GetKeyboardLayout Lib user32 (ByVal dwLayout As Long) As Long
Private Declare Function GetForegroundWindow Lib user32 () As Long
Private Declare Function GetWindowThreadProcessId Lib user32 (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Sub Hook_KeyDown(KeyCode As Integer, Shift As Integer)
DimStrCodeAsString
StrCode = CodeToString(KeyCode)
If StrCode = [Shift] Or StrCode = [Alt] Or StrCode = [Ctrl] Then
If Shift = vbAltMask + vbCtrlMask Then StrCode = [Alt + Ctrl]
If Shift = vbAltMask + vbShiftMask Then StrCode = [Alt + Shift]
If Shift = vbCtrlMask + vbShiftMask Then StrCode = [Ctrl + Shift]
If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = [Ctrl + Shift +Alt]
Else
If Shift = vbShiftMask Then StrCode = [Shift] + & StrCode
If Shift = vbCtrlMask Then StrCode = [Ctrl] + & StrCode
If Shift = vbAltMask Then StrCode = [Alt] + & StrCode
If Shift = vbAltMask + vbCtrlMask Then StrCode = [Alt + Ctrl] + & StrCode
If Shift = vbAltMask + vbShiftMask Then StrCode = [Alt + Shift] + & StrCode
If Shift = vbCtrlMask + vbShiftMask Then StrCode = [Ctrl + Shift] + & StrCode
If Shift = vbCtrlMask + vbShiftMask + vbAltMask Then StrCode = [Ctrl + Shift +Alt] + & StrCode
End If
If LCase(StrCode) = LCase(HotKey) Then ' This section is a simple function after keyboard HOOK, which is to hide and display the from window.
If App.TaskVisible = False Then
Me.Show
App.TaskVisible = True
Else
Me.Hide
App.TaskVisible = False
End If
End If
End Sub
Private Function CodeToString(nCode As Integer) As String
DimStrKeyAsString
Select Case nCode
Case vbKeyBack: StrKey = BackSpace
Case vbKeyTab: StrKey = Tab
Case vbKeyClear: StrKey = Clear
Case vbKeyReturn: StrKey = Enter
Case vbKeyShift: StrKey = Shift
Case vbKeyControl: StrKey = Ctrl
Case vbKeyMenu: StrKey = Alt
Case vbKeyPause: StrKey = Pause
Case vbKeyCapital: StrKey = CapsLock
Case vbKeyEscape: StrKey = ESC
Case vbKeySpace: StrKey = SPACEBAR
Case vbKeyPageUp: StrKey = PAGE UP
Case vbKeyPageDown: StrKey = PAGE DOWN
Case vbKeyEnd: StrKey = END
Case vbKeyHome: StrKey = HOME
Case vbKeyLeft: StrKey = LEFT ARROW
Case vbKeyUp: StrKey = UP ARROW
Case vbKeyRight: StrKey = RIGHT ARROW
Case vbKeyDown: StrKey = DOWN ARROW
Case vbKeySelect: StrKey = SELECT
Case vbKeyPrint: StrKey = PRINT SCREEN
Case vbKeyExecute: StrKey = EXECUTE
Case vbKeySnapshot: StrKey = SNAPSHOT
Case vbKeyInsert: StrKey = INS
Case vbKeyDelete: StrKey = DEL
Case vbKeyHelp: StrKey = HELP
Case vbKeyNumlock: StrKey = NUM LOCK
Case vbKey0 To vbKey9: StrKey = Chr$(nCode)
Case vbKeyA To vbKeyZ: StrKey = LCase(Chr$(nCode)) 'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
Case vbKeyF1 To vbKeyF16: StrKey = F & CStr(nCode - 111)
Case vbKeyNumpad0 To vbKeyNumpad9: StrKey = Numpad & CStr(nCode - 96)
Case vbKeyMultiply: StrKey = Numpad {*}
Case vbKeyAdd: StrKey = Numpad {+}
Case vbKeySeparator: StrKey = Numpad {ENTER}
Case vbKeySubtract: StrKey = Numpad {-}
Case vbKeyDecimal: StrKey = Numpad {.}
Case vbKeyDivide: StrKey = Numpad {/}
Case Else
StrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))) & Str(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
End Select
CodeToString = [ & StrKey & ]
End Function