在 Vb6 之外檢測按鍵

Question

我目前正在修改一個運行 Windows Server 2k 的非常舊的系統。 我正在處理的要求之一是在我們無法修改的另一個程序的某個窗口中阻止鍵盤按下。

一般來說，我的過程很好，因為我檢測到按鍵，然后在它們發生時終止窗口，但是，當有時 Control/Windows Key/etc 卡住並且整個系統傾向於采取行動時，我發現並使用的唯一工作代碼會導致許多問題出怪了。 這是我用於掛鈎的代碼：

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 Declare Function SetWindowsHook Lib "user32" Alias "SetWindowsHookA" (ByVal nFilterType As Long, ByVal pfnFilterProc As Long) As Long
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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Global Const WH_KEYBOARD_LL = 13

Public hook As Long

Public Const HC_ACTION = 0
Type HookStruct
    vkCode As Long
    scancode As Long
    FLAGS As Long
    time As Long
    dwExtraInfo As Long
End Type

Public active As Boolean
Public value As String

Public Function myfunc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim kybd As HookStruct

    myfunc = True


    If code = HC_ACTION And wParam <> 257 Then
            If active Then

            'SendKeys "{ESC}"
            'MsgBox ("keypressed")
            End If

        myfunc = CallNextHookEx(hook, code, wParam, lParam)
    ElseIf code < 0 Then
        myfunc = CallNextHookEx(hook, code, wParam, lParam)
    End If

End Function

通常代碼是有效的，但是如果您按 Control、Alt 或 Windows 鍵，則整個系統往往會失控。

是否有更好的方法來檢測系統外部/特定窗口中的那些按鍵，甚至可能，還是我在這里做錯了什么？

Answer 1

請參閱以下主題： 檢測應用程序外的按鍵

您可以嘗試這兩種其他方法，看看它們是否更穩定：

RegisterHotKey，一個定義系統范圍熱鍵的函數：

Declare Function RegisterHotKey Lib "user32" Alias "RegisterHotKey" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long

或 GetAsyncKeyState，該函數確定在調用該函數時某個鍵是向上還是向下，以及該鍵是否在上次調用 GetAsyncKeyState 后被按下：

Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer

您可以運行計時器並不斷檢查 GetAsyncKeyState 以查看您要查找的鍵是否已被按下：

Private Sub tmrKeyPressCheck_Timer()
    Dim iCounter As Integer

    For iCounter = 64 To 90
        If CheckKey(iCounter) Then
            txtKeyPressLog.Text = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & ": " & Chr(iCounter) & vbCrLf & txtKeyPressLog.Text
        End If
    Next

End Sub

Private Function CheckKey(ByVal p_lngKey As Long) As Boolean
    Dim iReturn As Integer

    iReturn = GetAsyncKeyState(p_lngKey)

    CheckKey = (iReturn <> 0)

End Function

Answer 2

這是最終沒有問題的代碼：

Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Const LLKHF_EXTENDED = &H1&
Private Const LLKHF_INJECTED = &H10&
Private Const LLKHF_ALTDOWN = &H20&
Private Const LLKHF_UP = &H80&

Private Const VK_RIGHT = &H27
Private Const VK_LEFT = &H25
Private Const VK_RSHIFT = &HA1

Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  FLAGS As Long
  time As Long
  dwExtraInfo As Long
End Type

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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public value As String
Public active As Boolean

Public Function HookKeyboard() As Long
    On Error GoTo ErrorHookKeyboard
    m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
    HookKeyboard = m_hDllKbdHook
    Exit Function
ErrorHookKeyboard:
    MsgBox Err & ":Error in call to HookKeyboard()." _
    & vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
    Exit Function
End Function

Public Sub UnHookKeyboard()
    On Error GoTo ErrorUnHookKeyboard
    UnhookWindowsHookEx (m_hDllKbdHook)
    Exit Sub
ErrorUnHookKeyboard:
    MsgBox Err & ":Error in call to UnHookKeyboard()." _
    & vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
    Exit Sub
End Sub


Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Static kbdllhs As KBDLLHOOKSTRUCT
    If nCode = HC_ACTION Then
        Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
                If active Then

            MsgBox ("keypressed")
            End If

    End If

我只需要在主窗體中調用 HookKeyboard/UnhookKeyboard