在 Vb6 之外检测按键

Question

我目前正在修改一个非常旧的系统运行 Windows Server 2k。我正在处理的其中一项要求是在我们无法修改的另一个程序的某个 window 处阻止键盘按下。

通常我的过程很好，因为我检测到按键，然后在它们发生时终止 window，但是我发现并使用的唯一工作代码有时会导致很多问题 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 键，那么整个系统就会变得混乱。

是否有更好的方法来检测 system/in 特定 window 之外的那些按键，甚至可能，或者我在这里做错了什么？

Answer 1

请参阅以下线程：Detect keypress outside your application

您可以尝试这两种其他方法，看看它们是否更稳定：

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

在 Vb6 之外检测按键

Detecting a Keypress outside Vb6

vb6