高分求教:如何捕获在WINDOWS操作中的键盘事件??

Question

  如何拦截键盘输入来源:cww这是使用Keyboard Hook 的范例，它的解释请查VB5 Call WinAPI技巧
或Hook的简介
'以下在.Bas
Option ExplicitDeclare Function SetWindowsHookEx Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" _
    (ByVal hHook As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
   ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As LongPublic hnexthookproc As Long
Public Const HC_ACTION = 0
Public Const WH_KEYBOARD = 2Public Sub UnHookKBD()
If hnexthookproc <> 0 Then
   UnhookWindowsHookEx hnexthookproc
   hnexthookproc = 0
End If
End Sub
Public Function EnableKBDHook()
If hnexthookproc <> 0 Then
   Exit Function
End If
hnexthookproc = SetWindowsHookEx(WH_KEYBOARD, AddressOf _
            MyKBHFunc, App.hInstance, 0)
If hnexthookproc <> 0 Then
   EnableKBDHook = hnexthookproc
End If
End Function
Public Function MyKBHFunc(ByVal iCode As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
  '这三个叁数是固定的，不能动，而MyKBHFunc这个名称只要和
  'SetWindowsHookex()中 AddressOf後的名称一样便可，不一定叫什麽
  'wParam 是传入按了哪个key的virtual-key code  '如果您将以下的两行un则所有键盘的输入皆没有作用
  'MyKBHFunc = 1  '吃掉讯息
  'Exit Function  MyKBHFunc = 0 '讯息要处理
  If iCode < 0 Then
    MyKBHFunc = CallNextHookEx(hnexthookproc, iCode, wParam, lParam)
    Exit Function
  End If
  If wParam = vbKeySnapshot Then  '侦测 有没有按到PrintScreen键
    MyKBHFunc = 1 '在这个Hook便吃掉这个讯息
    Debug.Print "haha"
  Else
    Call CallNextHookEx(hnexthookproc, iCode, wParam, lParam)
  End If
End Function'以下在Form
Private Sub Form_Load()
Call EnableKBDHook
End SubPrivate Sub Form_Unload(Cancel As Integer)
Call UnHookKBD
End Sub

Answer 1

to baoxiang(包香)
为什么我焦点不在VB上的时候还是没用

Answer 2

to Yan5453()　
是的,我把程序中Debug.Print "haha"改为form1.text1.text="ok" 然后打开WINDOWS中的记事本,再按PrintScreen键,然后点击VB程序查看结果, form1中的text1并没显示"ok"

Answer 3

呵呵，那个程序只能做本地hook，你需要的是全局hook,VB做全局HOOK很麻烦，你用VC做吧。

Answer 4

我也在搞这个问题！
是好像得做个DLL!

Answer 5

要的话，与我联系，我有一打这样的源程序
[email protected]

Answer 6

用VB写一有这个Hook的个ActiveEXE,然后在你的程序中引用这个ActiveEXE,这个Hook就成了全局Hook了，这样就能Hook所有的键盘消息。没错

Answer 7

我没用过Hook，但下面的API很好用啊。
Public Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer

Answer 8

ActiveDLL+Hook+VB=very good可以实现全局Hook!

Answer 9

用日志钩子
正好我有原代码：）
http://507www.go.163.com/file/hook.zip

Answer 10

给你源码
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const HC_ACTION = 0Public Const WH_JOURNALRECORD = 0
Type EVENTMSG
        message As Long
        paramL As Long
        paramH As Long
        time As Long
        hwnd As Long
End Type
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
Declare Function UnhookWindowsHookEx Lib "user32" _
   (ByVal hHook As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
   ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
  (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" _
  (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPublic hHook As Long
Public msg As EVENTMSGSub EnableHook() 
   hHook = SetWindowsHookEx(0, AddressOf HookProc, App.hInstance, 0)
End SubSub FreeHook()
    Dim ret As Long
    ret = UnhookWindowsHookEx(hHook)
End SubFunction HookProc(ByVal code As Long, ByVal wParam As Long, _
                ByVal lParam As Long) As Long
Dim i As Long, j As Integer, str1 As String
If code <> HC_ACTION Then
   HookProc = CallNextHookEx(hHook, code, wParam, lParam)
   Exit Function
End If
CopyMemory msg, lParam, LenB(msg)
 
If msg.message = WM_KEYDOWN Then
    i = MapVirtualKey(msg.paramL, 2)
    
     str1 = Chr(i And &HFF)
     Form1.List1.AddItem (str1)
     
      End If
HookProc = CallNextHookEx(hHook, code, wParam, lParam)
End Function