苦苦追索多日无果 恳请高手指点迷津 请求高手修改下VBA能实现的全局钩子!!
我好想知道答案啊!!现在心情特别焦急,偏执型精神病又犯了.....
找了好多代码,无奈本人水平有限未能看的个明了,贴出三段代码,恳求高手帮忙修改下代码,小生不胜感谢!!
以下三段是某些好心人的代码,我稍稍修改了,但是无法实现键盘钩子:
代码1:
'用VB实现的全局键盘钩子
'2010-04-06 13:30
'代码功能:实时监测Caps Lock、NumLock、Scroll Lock三个按件的状态,
'并显示在Label1 Label2 Label3三个标签中
'.bas模块中
Public m_hDllKbdHook As Long 'public variable holding
'the handle to the hook procedure
Public Const WH_KEYBOARD_LL As Long = 13 'enables monitoring of keyboard
'input events about to be posted
'in a thread input queue
Private Const HC_ACTION As Long = 0 'wParam and lParam parameters
'contain information about a
'keyboard message
Public Const VK_CAPITAL As Long = &H14
Public Const VK_NUMLOCK As Long = &H90
Public Const VK_SCROLL As Long = &H91
Private Const LLKHF_UP As Long = &H80& 'test the transition-state flag
Public Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Type KBDLLHOOKSTRUCT
vkCode As Long 'a virtual-key code in the range 1 to 254
scanCode As Long 'hardware scan code for the key
flags As Long 'specifies the extended-key flag,
'event-injected flag, context code,
'and transition-state flag
time As Long 'time stamp for this message
dwExtraInfo As Long 'extra info associated with the message
End Type
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 UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal cb As Long)
Public Declare Function GetKeyboardState Lib "user32" _
(kbArray As KeyboardBytes) As Long
Public Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Public Function LowLevelKeyboardProc(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim kbdllhs As KBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
If (kbdllhs.flags And LLKHF_UP) Then
Select Case kbdllhs.vkCode
Case VK_NUMLOCK
Range("A1") = (GetKeyState(VK_NUMLOCK) = &HFF81)
Case VK_CAPITAL
Range("A1") = (GetKeyState(VK_CAPITAL) = &HFF81)
Case VK_SCROLL
Range("A1") = (GetKeyState(VK_SCROLL) = &HFF81)
Case Else
End Select
End If
End If 'nCode = HC_ACTION
LowLevelKeyboardProc = CallNextHookEx(m_hDllKbdHook, _
nCode, _
wParam, _
lParam)
End Function
Sub Form_Load()
Dim kbdState As KeyboardBytes
Call GetKeyboardState(kbdState)
' With Label1
' .Caption = "Numlock is ON"
' .Alignment = vbRightJustify
' End With
' With Label2
' .Caption = "Caps lock is ON"
' .Alignment = vbRightJustify
' End With
' With Label3
' .Caption = "Scroll lock is ON"
' .Alignment = vbRightJustify
' End With
' Label1.Visible = kbdState.kbByte(VK_NUMLOCK) = 1
' Label2.Visible = kbdState.kbByte(VK_CAPITAL) = 1
' Label3.Visible = kbdState.kbByte(VK_SCROLL) = 1
Range("B1") = kbdState.kbByte(VK_NUMLOCK) = 1
Range("B2") = kbdState.kbByte(VK_CAPITAL) = 1
Range("B3") = kbdState.kbByte(VK_SCROLL) = 1
'set and obtain the handle to the keyboard hook
m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, _
AddressOf LowLevelKeyboardProc, _
0&, _
0&)
If m_hDllKbdHook = 0 Then 'App.Hinstance
MsgBox "Failed to install low-level keyboard hook."
End If
End Sub
Sub Unload() 'Cancel As Integer, UnloadMode As Integer
If m_hDllKbdHook <> 0 Then
Call UnhookWindowsHookEx(m_hDllKbdHook)
End If
End Sub
[解决办法]
不可能运行不了,你注意到说明没有?除两个按钮外,其余属性都是默认的
1、先在form上添加两个按钮,一个叫“安装钩子”,一个叫“卸载钩子”,指的是Caption,不是name
2、表单代码部份必须复制到窗体代码块
3、模块代码部份必须复制到模块中,不能复制到窗体中
4、代表Excel的不是App,而是Application,所以
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
应改为
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, Application.Hinstance, 0)
5、运行不了你应写出错误提示,否则谁也帮不了你
[解决办法]
全局键盘鼠标的HOOK在WIN2000以上就有专门的HOOK类型了,你们上面也用到了的.
我这里有个类,别人在EXCEL里也实际用过的,拿去用不是了,弄得太麻烦了.
http://www.m5home.com/bak_blog/article/245.html
这是封装好的键盘鼠标全局HOOK类.