|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 sifo-d 于 2012-5-24 11:40 编辑
我是新手,最近刚接触VBA,在coreldraw中准备写个小程序,顺便想加个钩子,我是在win7 64位下写的,在win7下能正常钩,并写vba7 vba6都兼容了,但是我放到xp下就不行了,hHook一直等于0,钩不住,求解答,win7 64位下很正常- #If VBA7 = False Then
- Private 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
-
- Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
-
- Private Declare Function CallNextHookEx Lib "user32" ( _
- ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
-
- Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
- Private Declare Function GetAsyncKeyStateA Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer
- #Else
- Private 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 Long
-
- Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
-
- Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
- ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As Long
-
- Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As LongPtr, ByVal Length As LongPtr)
- Private Declare PtrSafe Function GetAsyncKeyStateA Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As LongPtr) As Integer
- #End If
- Private hHook As Long
- Private Const WH_KEYBOARD_LL = 13
- Private Const WM_KEYDOWN = &H100
- Dim num As Long
- Private Type LpConvert
- vkCode As Long
- scanCode As Long
- flags As Long
- time As Long
- dwExtraInfo As Long
- End Type
- '设置键盘钩子
- Sub setHook()
- If hHook = 0 Then
- hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf hookFunc, Application.ID, 0)
- #If VBA7 Then
- MsgBox "vba7" + CStr(hHook)
- #Else
- MsgBox "vba6"
- #End If
- End If
- End Sub
- '解除钩子过程
- Sub unloadHook()
- If hHook <> 0 Then
- Call UnhookWindowsHookEx(hHook)
- hHook = 0
- MsgBox ("已解除钩子")
- End If
- End Sub
- '钩子响应程序
- #If VBA7 = False Then
- Private Function hookFunc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Static lpconv As LpConvert
-
- If nCode < 0 Then
- hookFunc = CallNextHookEx(hHook, nCode, wParam, lParam)
- Exit Function
- End If
-
-
- Call CopyMemory(lpconv, ByVal lParam, Len(lpconv))
-
- If wParam = WM_KEYDOWN And lpconv.vkCode = vbKeyH And (32768 + GetAsyncKeyStateA(vbKeyControl) = 1) Then
- main.pageTotal.Caption = num + 1 '这块代码只是用来测试学习
- num = num + 1
- End If
-
- End Function
- #Else
- Private Function hookFunc(ByVal nCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
- Static lpconv As LpConvert
-
- If nCode < 0 Then
- hookFunc = CallNextHookEx(hHook, nCode, wParam, lParam)
- Exit Function
- End If
-
- Call CopyMemory(lpconv, ByVal lParam, Len(lpconv)) '将lparam转换为键盘编码///////////////////////////////////////////
-
- If wParam = WM_KEYDOWN And lpconv.vkCode = vbKeyH Then
- main.pageTotal.Caption = (GetAsyncKeyStateA(vbKeyControl))
- num = num + 1
- End If
-
- End Function
- #End If
复制代码
|
|