【问题标题】:Using SetWindowsHookEx. in Excel 2010使用 SetWindowsHookEx。在 Excel 2010 中
【发布时间】:2017-07-26 10:41:33
【问题描述】:

这个功能让我抓狂!我正在尝试使用 SetWindwosHookEx 来避免用户击键,但我无法使其正常工作。

我一直在网上查看许多代码,但我不明白为什么它不适合我。首先,这是因为我使用的是 Excel 2010(64 位),我的代码不适合它,但现在我不知道。

基本上,我创建了一个简单的代码,当我拉“g”时会向我显示一条消息,但发生的情况是当拉任何键时 Excel 崩溃。当我逐步运行代码时它不会崩溃,但如果我拉“g”,则消息会出现 3 次!

这是我的代码:

#If Win64 Then

Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpFn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPrt
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As LongPtr) As Integer
Private hWndPPT As LongPtr
Private HookHandle As LongPtr

'ADICIONAL
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPrt, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr



#Else
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook 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 Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private hWndPPT As Long
Private HookHandle As Long

'ADICIONAL
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

#End If



'Constants to be used in our API functions
'Private Const EM_SETPASSWORDCHAR = &HCC
'Private Const WH_CBT = 5
Private Const WH_KEYBOARD = 2
'Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

'Private hHook As Long


Public Sub RemoveHook()
    UnhookWindowsHookEx (HookHandle)
End Sub

Sub SetHook()
#If Win64 Then
Dim lThreadID As LongPtr
Dim lngModHwnd As LongPtr
#Else
Dim lThreadID As Long
Dim lngModHwnd As Long
#End If

lThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)

'Set a local hook
HookHandle = SetWindowsHookEx(WH_KEYBOARD, AddressOf NewProc, 0, lThreadID)
End Sub

Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    If lngCode < HC_ACTION Then
      NewProc = CallNextHookEx(HookHandle, lngCode, wParam, lParam)
      Exit Function
    End If

    If wParam = 71 Then
        'MsgBox "g"
        'NewProc = 1
        wParam = 70
        'Exit Function
    End If

    'This line will ensure that any other hooks that may be in place are
    'called correctly.
    CallNextHookEx HookHandle, lngCode, wParam, lParam

End Function

【问题讨论】:

  • 您需要检查您的声明 - 并非所有内容都应该是 LongPtr。那些应该是LongPtr 而不是LongPrt
  • 抱歉我的无知,但哪些不是 LongPtr?这是我第一次为 64 位编码。谢谢。

标签: vba excel hook setwindowshookex


【解决方案1】:

64 位的正确声明是:

Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Public 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
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

我实际上看不到您发布的代码在 64 位上将如何运行。

【讨论】:

  • 谢谢!。实际上,它并没有真正起作用。一旦我拉动钥匙,代码就会进入一个不可阻挡的循环。在准备好有关 hooks、setwindowsex、callnexthookex 等的信息和许多代码之后,我看不到错误。所有示例代码看起来都很简单,但我无法让它工作
  • 再次嗨,我做了一些改进,这段代码几乎可以正常工作,但有几个问题:当我运行代码时,函数没有返回我的密钥拉所以什么也没写,“NewProc_64”函数运行两次:
  • 应该SendDlgItemMessage GetClassName 也是PtrSafe 吗?
  • @mwfearnley 是的,他们应该!我会更新的。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-07-22
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多