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

[birdlow]

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

[zyxxyzhi]

有什么用啊？

[laviewpbt]

API HooK

[starsoulxp]

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

[starsoulxp]

如何使键盘、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 = &H209

Const WM_MOUSEFIRST = &H200

Public Const WM_KEYLAST = &H108

Public Const WM_KEYFIRST = &H100

Public Const WH_JOURNALRECORD = 0

Public Const WH_JOURNALPLAYBACK = 1



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

Public hNxtHook As Long ' handle of Hook Procedure

Public msg As EVENTMSG



Sub EnableHook()

hNxtHook = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf HookProc, App.hInstance, 0)

End Sub

Sub FreeHook()

Dim ret As Long

ret = UnhookWindowsHookEx(hNxtHook)

End Sub

Function HookProc(ByVal code As Long, ByVal wParam As Long, _

ByVal lParam As Long) As Long

HookProc = CallNextHookEx(hNxtHook, code, wParam, lParam)

End Function



'以下在Form中，需求:一个Command1, 一个text1

Private Sub Command1_Click()

Dim str5 As String, len5 As Long, i As Long



Call EnableHook

str5 = "这是一个测试JournalPlayBackHook的程式"

len5 = Len(str5)

For i = 1 To len5

Text1.Text = Mid(str5, 1, i)

Text1.Refresh

Sleep (200)

Next

Call FreeHook

End Sub

[starsoulxp]

如何拦截键盘输入



来源:cww



这是使用Keyboard Hook 的范例



'以下在.Bas

Option Explicit



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



Public hnexthookproc As Long

Public Const HC_ACTION = 0

Public Const WH_KEYBOARD = 2



Public 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



'如果您将以下的两行unmark则所有键盘的输入皆没有作用

'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 Sub



Private Sub Form_Unload(Cancel As Integer)

Call UnHookKBD

End Sub

[starsoulxp]

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

[rfq]

钩子

[birdlow]

多谢大家，但我怎么用某个热键，比如a键。唤醒我的键盘和鼠标呢？多谢

[dongge2000]

Option Explicit

Public 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 Long

Public 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 Function

Public 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 Explicit

Private Sub Check1_Click()
If Check1.Value Then
RegLockKey
Else
UnLockKey
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnLockKey
End Sub
============================
一个模块+一个窗体+一个CHECK1控件。一个键也不留Ctrl+Alt+Del也不放过。