Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Private Const VK_CAPITAL As Long = &H14
Private Const VK_NUMLOCK As Long = &H90
Private Const VK_SCROLL As Long = &H91
Public Const WH_KEYBOARD_LL = 13
Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Dim p As KBDLLHOOKSTRUCT
Public Sub LogEvent(ByVal What As String)
Debug.Print What
End Sub
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'WARNING: DO NOT MODIFY THE PARAMETERS OF THIS FUNCTION, OTHERWISE CALLBACK
'WILL CRASH. IF YOU PRODUCE A RUN-TIME ERROR HERE, VB WILL CRASH AND DISAPPEAR.
'Note: Hooked callback functions are subject to a timeout, so keep loops to a
'bare minimum.
   Dim fEatKeystroke As Boolean
If (nCode = HC_ACTION) And _
    (wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP _
    Or wParam = WM_SYSKEYUP) Then
        CopyMemory p, ByVal lParam, Len(p)
        'Copy the struct given by lparam into p
        If (p.flags = 128) Or (p.flags = -127) Then 'Key Down
            Select Case p.vkCode
                Case VK_CAPITAL
                    If (GetKeyState(p.vkCode) And &H1) Then
                        LogEvent "Caps Lock On"
                    Else
                        LogEvent "Caps Lock Off"
                    End If
                Case VK_NUMLOCK
                    If (GetKeyState(p.vkCode) And &H1) Then
                        LogEvent "Num Lock On"
                    Else
                        LogEvent "Num Lock Off"
                    End If
                Case VK_SCROLL
                    If (GetKeyState(p.vkCode) And &H1) Then
                        LogEvent "Scroll Lock On"
                    Else
                        LogEvent "Scroll Lock Off"
                    End If
            End Select
            Debug.Print VKKeyToName(p.vkCode) & " Up"
        ElseIf Not (GetKeyState(p.vkCode) And &HF0000000) Then 'Key Up
            Debug.Print VKKeyToName(p.vkCode) & " Down"
        End If
End If
1    If fEatKeystroke Then
        LowLevelKeyboardProc = -1
    Else
        LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
    End If
End Function
Public Function VKKeyToName(ByVal VKKeyCode As Long) As String
'Used to be a massive select case statement here
'along the lines of Case VK_SHIFT VKKeyToName = "Shift"
'- deleted to shrink size
VKKeyToName = "Key number " & VKKeyCode
End Function

Dim hhkLowLevelKybd As Long 'Holds our callback handle
Private Sub Form_Load()
MsgBox "Warning - this program uses API callback." & vbNewLine & _
    "Always terminate with the close button on the form," & _
    " never with the stop button.", vbInformation, "Warning"
'Register our callback function as a keyboard "hook"
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
End Sub
Private Sub Form_Paint()
Me.Cls
Me.Print "Watch the debug window!"
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unregister the function
If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub