使用SetWindowsHookEx。在Excel 2010中

Question

这个功能让我疯狂！我正在尝试使用SetWindwosHookEx来避免用户的一些击键，但我无法使其正常工作。

我一直在网上浏览很多代码，但我不明白为什么它不适合我。首先，这是因为我使用Excel 2010（64位），我的代码不适合它，但现在我不知道。

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

这是我的代码：

#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 

Answer 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 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 Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 

我不能真正看到你是如何发布的代码将在64位上运行的。