首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

苦苦追索多日无果 恳请迷津 请求高手修改下VBA能实现的全局钩子!

2013-03-26 
苦苦追索多日无果 恳请高手指点迷津 请求高手修改下VBA能实现的全局钩子!!我好想知道答案啊!!现在心情特别

苦苦追索多日无果 恳请高手指点迷津 请求高手修改下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类.

热点排行