键盘挂钩不起作用? KeyboardProc回调函数未执行?

时间:2019-02-19 03:18:10

标签: excel vba winapi win64

编辑以下注释:

https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-setwindowshookexa

HHOOK SetWindowsHookExA(
  int       idHook,
  HOOKPROC  lpfn,
  HINSTANCE hmod,
  DWORD     dwThreadId
);

lpfn

类型:HOOKPROC

指向钩子过程的指针。如果dwThreadId参数为零或指定由其他进程创建的线程的标识符,则lpfn参数必须指向DLL中的挂钩过程。否则,lpfn可以指向与当前进程关联的代码中的挂钩过程。

hmod

类型:HINSTANCE

包含lpfn参数所指向的挂钩过程的DLL的句柄。如果dwThreadId参数指定了由当前进程创建的线程,并且挂钩过程在与当前进程关联的代码内,则hMod参数必须设置为NULL。


我不明白为什么这不起作用。对于此版本,我不阻止任何钩子。我只是简单地输入txt文件,以记下键盘回调函数处理该消息的时间。但是,当我逐步执行主程序时,该钩子会捕获OK。但是我认为KeyboardCallBack永远不会执行,因为我的日志的初始标头是空的。

常量和API:

Private Declare PtrSafe 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 PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)

Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
   (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

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

Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13&
Private KeyboardHandle As Long

HOOK:

Public Sub HookKeyboard()
    KeyboardHandle = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardCallback, Application.Hinstance, 0)
End Sub

键盘回调和辅助功能:

Public Function KeyboardCallback(ByVal Code As Long, _
                                  ByVal wParam As Long, _
                                  ByVal lParam As Long) As Long
    Call TimeStamp
    Static Hookstruct As KBDLLHOOKSTRUCT

    If Code = HC_ACTION Then
        Call CopyMemory(Hookstruct, ByVal lParam, Len(Hookstruct))
        If BlockKey(Hookstruct) = True Then
            KeyboardCallback = 1
            Exit Function
        End If
    End If

  KeyboardCallback = CallNextHookEx(KeyboardHandle, _
    Code, wParam, lParam)
End Function

    Private Function BlockKey(ByRef Hookstruct As KBDLLHOOKSTRUCT) As Boolean
        BlockKey = False
    End Function

    Private Function TimeStamp()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")

        Dim TSO As Object
        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 1)

        Dim FileString As String
        FileString = TSO.ReadAll
        TSO.Close

        FileString = FileString & " " & Now() & " "

        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 2)
        TSO.WriteLine FileString
        TSO.Close

        Set FSO = Nothing
        Set TSO = Nothing
    End Function

测试:

Sub testHook()
    Hook.HookKeyboard
Stop
'write a bunch of stuff
Stop
    Hook.UnhookKeyboard
End Sub

Sub testWriteFile()
    Hook.TimeStamp
End Sub

0 个答案:

没有答案