使用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位上運行的。