CODEWITHSUNDEEP
vbasetwindowshookex
Y.S.
Y.S.

Reputation: 317

Problem displaying the full name, including the side, of a keyboard key captured in WindowsHook

I wrote a simple VBA program, that uses a WindowsHook to capture keystrokes, display their ASCII codes and names.

The problem is that the program doesn't display the full name of the keys: Alt, Ctrl, Shift which also includes their side, except for the "Right Shift" key. I guess the problem is in the functions: CopyMemory, GetKeyNameText

For example, the following keys do display as they should:

ASCII: 20 Char/name: Caps Lock
ASCII: 145 Char/name: Scroll Lock
ASCII: 161 Char/name: Right Shift

The following keys are not displayed properly:

ASCII: 160 Char/name: Shift (missing "Left")
ASCII: 162 Char/name: Ctrl (missing "Left")
ASCII: 164 Char/name: Alt (missing "Left")
ASCII: 163 Char/name: Ctrl (missing "Right")
ASCII: 165 Char/name: Alt (missing "Right")

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpString As String, ByVal nSize As Long) As Long

Private Const WH_KEYBOARD_LL As Long = 13
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_SYSKEYDOWN As Long = &H104

Private Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As LongPtr
End Type

Private btnStart As Button
Private btnStop As Button
Private hHook As LongPtr

Public Sub ButtonEnabled(ByRef btn As Button)
    btn.Enabled = True
    btn.Font.ColorIndex = Default
End Sub

Public Sub ButtonDisabled(ByRef btn As Button)
    btn.Enabled = False
    btn.Font.ColorIndex = 15
End Sub

Sub ButtonsInitialize()
    Set btnStart = ActiveSheet.Buttons("Button 1")
    Set btnStop = ActiveSheet.Buttons("Button 2")
    ButtonEnabled btnStart
    ButtonDisabled btnStop
End Sub

Public Sub CaptureStart()
    If btnStart.Enabled Then
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, 0, 0)
        ButtonDisabled btnStart
        ButtonEnabled btnStop
    End If
End Sub

Public Sub CaptureStop()
    If btnStop.Enabled Then
        UnhookWindowsHookEx hHook
        ButtonDisabled btnStop
        ButtonEnabled btnStart
    End If
End Sub

Private Function KeyboardProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
    
        Dim kbInfo As KBDLLHOOKSTRUCT
        Dim keyText As String
        Dim lpString As String * 255
        
        CopyMemory kbInfo, ByVal lParam, LenB(kbInfo)

        If GetKeyNameText(kbInfo.scanCode * &H10000, lpString, 255) > 0 Then
            keyText = "Char/name: " & lpString
        End If
        
        MsgBox "ASCII: " & kbInfo.vkCode & vbNewLine & keyText, , "Captured key"
    End If
    
    KeyboardProc = CallNextHookEx(0, nCode, wParam, lParam)
    
End Function

Upvotes: 0

Views: 84

Answers (1)

JohnM
JohnM

Reputation: 3350

This is an updated version of your KeyboardProc function that checks the 'extended key' bit / flag ... if it is set, it gets the name of the 'extended key'. For reference, see the MS Docs for the Keyboard Input Windows API functions.

Private Function KeyboardProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
    
        Dim kbInfo As KBDLLHOOKSTRUCT
        Dim keyText As String
        Dim lpString As String * 255
        
        CopyMemory kbInfo, ByVal lParam, LenB(kbInfo)

        If GetKeyNameText(kbInfo.scanCode * &H10000, lpString, 255) > 0 Then
            ' is the 'extended key' flag set (and is the key press either ALT or CTRL)?
            If (kbInfo.flags And 1) = 1 And (InStr(1, lpString, "ALT", vbTextCompare) <> 0 Or InStr(1, lpString, "CTRL", vbTextCompare) <> 0) Then
                ' if so, get the extended key name
                GetKeyNameText kbInfo.scanCode * &H10000 + &H1000000, lpString, 255
            End If
            keyText = "Char/name: " & lpString
        End If
        
        Debug.Print Now, "ASCII: " & kbInfo.vkCode & vbNewLine & keyText, , "Captured key"
    End If
    
    KeyboardProc = CallNextHookEx(0, nCode, wParam, lParam)
    
End Function

... I've added comments for the additional lines and also changed MsgBox to Debug.Print (which you can, of course, change back) so that the code immediately reports the key in the Immediate window.

Upvotes: 0

Related Questions