2017-07-26 33 views
0

この機能は私を夢中にしています!私はSetWindwosHookExを使用してユーザーからのキーストロークを回避しようとしていますが、正しく動作させることはできません。SetWindowsHookExを使用しています。 Excel 2010で

私はウェブ上で多くのコードを見てきましたが、なぜ私にとってうまくいかないのか分かりません。まず、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 
+0

宣言を確認する必要があります。すべてが「LongPtr」である必要はありません。それらは 'LongPrt'ではなく' LongPtr'でなければなりません。 – Rory

+0

私の知らないことは申し訳ありませんが、LongPtrではないものはありますか?私が64ビットを初めてコーディングする時です。ありがとう。 – Rafavb

答えて

0

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ビットでまったく実行する方法を見ることができません。

+0

ありがとうございます。実際には、実際には機能しません。一度キーを押すと、コードは止められないループに入ります。私は、フック、setwindowsex、callnexthookexなどに関する情報と多くのコードを準備した後、エラーを見ることができません。すべてのサンプルコードはとてもシンプルですが、私はそれを動作させることはできません – Rafavb

+0

もう一度、このコードはほとんど正常に動作します... – Rafavb

+0

もう一度、私は少し改良を加えましたが、このコードはほとんどうまく動作しますが、いくつかの問題があります。コードを実行すると、関数はキーを返しません私は何も書かれていないので、 "NewProc_64"関数が2回実行されるようにしています。 – Rafavb

関連する問題