Question

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

通常情况下，当我检测到按键并终止窗口时，我的过程就很好了，但是当有时Control / Windows Key / etc被卡住并且整个系统被卡住时，我发现并使用的唯一工作代码会引起很多问题往往表现得很怪异。这是我用于Hook的代码：

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

请参见以下线程：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

2 个答案: