如何在VB程序中控制键盘？周末要用，请大家多帮忙，大恩不言谢！

Question

周末要交作业，要求如下：执行一个vb的程序，可以锁定键盘，只保留一个热键，触发该热键可以让该程序失效，键盘恢复正常。
多谢诸位高手

Answer 1

http://cache.baidu.com/c?word=vb%2C%BF%D8%D6%C6%3B%BC%FC%C5%CC&url=http%3A//www%2Ee096%2Ecom/cgi%2Dbin/topic%2Ecgi%3Fforum%3D9%26topic%3D36%26replynum%3D4%26show%3D&b=0&a=3&user=baidu

Answer 2

如何使键盘、Mouse失效(JournalPlayBack Hook)来源:cww我们常见一些导览系统或教学系统，会自动移动Mouse与Keyin字，而那个时候，我们不管Keyin或动Mouse都没有效，直到完成了导览系统的某个动作後才让使用者可以移动Mouse与做Keyin的动作；想做到这个，要借重JournalPlayBack Hook。JournalPlayBack Hook，它和JournalRecord Hook合称Journal Hook，它们作用的范围是整个System，也就是挂上这个Hook後，影响的层面不单是这个Process，而是所有的Process，而这两Hook又不用写在Dll之中，所以很好用。首先我们要知道由键盘和Mouse输入等的硬体讯息，会存到一个System Queue而後OS会到该System Queue看有没有讯息在其中，若有则撷取出来，看目前Active的Window是谁而将讯息Post给它。而挂上JournalRecord Hook时，当有讯息被撷取出来时，会先执行我们所设定的Hook Function(在vb中，一定要放在.BAS档之中)。这可以做什麽事呢？例如们可以Check整个系统是否有按了键盘或有没有移动Mouse(一般来说，KeyUp,KeyDown, MouseMove等Event只有Form在Active 时才收得到，挂上JournalRecord hook後，执行Hook的thread便能收到所有这些讯息)。再如，它既然能收到Keyboard、Mouse的讯息，那便可以将收到的讯息记录起来(记录於Memory或Disk都可以)，之後再依方才的顺序重新将讯息放送出来，可重新执行方才的动作(这不就是巨集的作法吗)，或许它叫JournalRecord便是这个原因。再来便是播放记录讯息的问题了，如果一面播放，一面有其他讯息插队(如移动Mouse)，那就不对了，所以JournalPlayBack这个Hook它会让Mouse、Keyboard都失效，当OS 要求读System Queue时，便会启动这个Hook，就在此时，我们可以把方才记录起来的讯息丢出一个出来，OS再要求读System Queue时，再丢下一个讯息，如此达重播的效果(所以才叫JournalPlayBack)，正因它会让键盘、Mouse失效，拿它来做导览、教学系统的自动Move Mouse或文字显示是最适合的了。'以下在.Bas中Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)Const WM_MOUSELAST = &H209Const WM_MOUSEFIRST = &H200Public Const WM_KEYLAST = &H108Public Const WM_KEYFIRST = &H100Public Const WH_JOURNALRECORD = 0Public Const WH_JOURNALPLAYBACK = 1Type EVENTMSGmessage As LongparamL As LongparamH As Longtime As Longhwnd As LongEnd TypeDeclare Function SetWindowsHookEx Lib "user32" Alias _"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _ByVal hmod As Long, ByVal dwThreadId As Long) As LongDeclare Function UnhookWindowsHookEx Lib "user32" _(ByVal hHook As Long) As LongDeclare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As LongPublic hNxtHook As Long ' handle of Hook ProcedurePublic msg As EVENTMSGSub EnableHook()hNxtHook = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf HookProc, App.hInstance, 0)End SubSub FreeHook()Dim ret As Longret = UnhookWindowsHookEx(hNxtHook)End SubFunction HookProc(ByVal code As Long, ByVal wParam As Long, _ByVal lParam As Long) As LongHookProc = CallNextHookEx(hNxtHook, code, wParam, lParam)End Function'以下在Form中，需求:一个Command1, 一个text1Private Sub Command1_Click()Dim str5 As String, len5 As Long, i As LongCall EnableHookstr5 = "这是一个测试JournalPlayBackHook的程式"len5 = Len(str5)For i = 1 To len5Text1.Text = Mid(str5, 1, i)Text1.RefreshSleep (200)NextCall FreeHookEnd Sub

Answer 3

如何拦截键盘输入来源:cww这是使用Keyboard Hook 的范例'以下在.BasOption ExplicitDeclare Function SetWindowsHookEx Lib "user32" Alias _"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _ByVal hmod As Long, ByVal dwThreadId As Long) As LongDeclare Function UnhookWindowsHookEx Lib "user32" _(ByVal hHook As Long) As LongDeclare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As LongPublic hnexthookproc As LongPublic Const HC_ACTION = 0Public Const WH_KEYBOARD = 2Public Sub UnHookKBD()If hnexthookproc <> 0 ThenUnhookWindowsHookEx hnexthookprochnexthookproc = 0End IfEnd SubPublic Function EnableKBDHook()If hnexthookproc <> 0 ThenExit FunctionEnd Ifhnexthookproc = SetWindowsHookEx(WH_KEYBOARD, AddressOf _MyKBHFunc, App.hInstance, 0)If hnexthookproc <> 0 ThenEnableKBDHook = hnexthookprocEnd IfEnd FunctionPublic 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 FunctionMyKBHFunc = 0 '讯息要处理If iCode < 0 ThenMyKBHFunc = CallNextHookEx(hnexthookproc, iCode, wParam, lParam)Exit FunctionEnd IfIf wParam = vbKeySnapshot Then'侦测 有没有按到PrintScreen键MyKBHFunc = 1 '在这个Hook便吃掉这个讯息Debug.Print "haha"ElseCall CallNextHookEx(hnexthookproc, iCode, wParam, lParam)End IfEnd Function'以下在FormPrivate Sub Form_Load()Call EnableKBDHookEnd SubPrivate Sub Form_Unload(Cancel As Integer)Call UnHookKBDEnd Sub

Answer 4

http://www.77169.com/Soft/Class57/Class58/200411/17224.asp

Answer 5

Option ExplicitPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As LongPublic Const WH_KEYBOARD_LL = 13
Public FileID As Integer
Public kHook As Long
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    LowLevelKeyboardProc = -1
End FunctionPublic Function RegLockKey() As Boolean
    kHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
    FileID = FreeFile
    '这句的路径可以用别的，如WINNT="c:\winnt\system32\taskmgr.exe"
    Open "c:\windows\system32\taskmgr.exe" For Random Lock Read Write As #FileID
End Function
Public Function UnLockKey() As Boolean
    If kHook <> 0 Then UnhookWindowsHookEx kHook: kHook = 0
    Close FileID
End Function
------------------------
Option ExplicitPrivate Sub Check1_Click()
    If Check1.Value Then
        RegLockKey
    Else
        UnLockKey
    End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
    UnLockKey
End Sub
============================
一个模块+一个窗体+一个CHECK1控件。一个键也不留Ctrl+Alt+Del也不放过。