說明
如果說，我們想得知某些鍵被KeyIn的頻率，或許會想，那設定Form KeyPreview不就可以，是啊，不過這樣做就變成您要使用者對著您的Form做事才有，出了這個Form就沒有辦法了，所以又要使用其他的方式了，第一個想到的是KeyBoard
Hook，是的，這是一個正確的想法。
不過說真的，在VB中我試過了一段時間的Remote Hook for KeyBoard Hook，如果搭配C或Delphi所作出的.DLL那應沒有問題，但以vb本身要做出Remote Hook，似乎只有使用ActiveX. Dll(因為Remote
Hook大多只能搭配.dll來做，而VB5不能做如同Function Call的.Dll，它只能做出ActiveX.Dll)，但我testing 了好久，都沒有成功，而王國榮先生它說會安排在未來的Run PC中做介紹，那這問題就等他來介紹了。
可是除了Keyboard
Hook之外尚有其他的Hook來做，那就是JournalRecord Hook，這個Hook和JournalPlayBack Hook一樣，是System Wide，但不用在.Dll之中，是個例外，但它要求系統中只能有一個這種Hook。JournalRecord Hook是在硬體訊息(Mouse, Keyboaed等)
在System queue中被取出時所引發的Hook，所以 我們也可以拿來用上一用。
其Hook Procedure定義如下
Function JournalRecordProc (
Byval code As Long , // hook code
ByVal wParam As Long , // undefined
ByVal lParam As Long // address of message being processed
) As Long
code有以下的值
HC_ACTION The lParam parameter points to an EVENTMSG structure
containing information about a message removed from the
system queue. The hook procedure must record the contents of
the structure by copying them to a buffer or file.
HC_SYSMODALOFF A system-modal dialog box has been destroyed. The hook
procedure must resume recording.
HC_SYSMODALON A system-modal dialog box is being displayed. Until the
dialog box is destroyed, the hook procedure must stop recording.
註:HC_SYSMODALOFF, HC_SYSMODUALON只在16位元程式產生一個system-modal
msgbox時才會收到。
wParam
Specifies a NULL value.
lParam
Points to an EVENTMSG structure that contains the message to be recorded.
而EventMsg的定義如下：
Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
message 若為鍵盤訊息可為WM_(SYS)KeyUp或WM_(SYSKeyDown),
Mouse訊息則是WM_XButtonUp / WM_XButtonDown /WM_MOUSEMOVE等
paramL
若為鍵盤訊息，則是鍵盤的虛擬碼，Mouse訊息則為Mouse相對Screen之x座標(Pixels)paramH若為鍵盤訊息，則是鍵盤的掃描碼，Mouse訊息則為Mouse相對Screen之y座標(Pixels)time訊息發生的時間(tick time)
而我們可以用MapVirtualKey來轉換虛擬碼成UnShift的Ascii值，本來嘛，這種虛擬碼或掃描碼本身就沒有Shift+某個鍵 的控制，而按Shift+A ==>"a"，那是TranslateMessage()所做出來的事。所以我們可另外使用GetAsyncKeystate()來Check
Shift有沒有按下。這個程式將重要的部份都完成，而記錄KeyBoard 到底是Keyin了哪些鍵，是Keyup/KeyDown有沒有搭配Shift鍵等，這些可以另外使用資料庫或檔案來記錄，這裡便不再多說明。
程式
'以下程式在.BAS
Public Const WM_KEYUP = &H101
Public Const HC_ACTION = 0
Public 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 Integer
Public hHook As Long ' handle of Hook Procedure
Public msg As EVENTMSG
Sub EnableHook()
hHook = SetWindowsHookEx(0, AddressOf HookProc, App.hInstance, 0)
End Sub
Sub FreeHook()
Dim ret As Long
ret = UnhookWindowsHookEx(hHook)
End Sub
Function HookProc(ByVal code As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim i As Long, j As Integer
If code <> HC_ACTION Then
HookProc = CallNextHookEx(hHook, code, wParam, lParam)
Exit Function
End If
CopyMemory msg, lParam, LenB(msg)
If msg.message = WM_KEYUP Then
j = GetAsyncKeyState(vbKeyShift) 'Check Shift是否正按下
i = MapVirtualKey(msg.paramL, 2) '轉換成unshift Ascii Code
If j <> 0 Then
Debug.Print Chr(i And &HFF); " Key Up with Shift Down"
Else
Debug.Print Chr(i And &HFF); " Key Up without Shift Down"
End If
End If
If msg.message = WM_KEYDOWN Then
j = GetAsyncKeyState(vbKeyShift)
i = MapVirtualKey(msg.paramL, 2)
If j <> 0 Then
Debug.Print Chr(i And &HFF); " Key Down with Shift Down"
Else
Debug.Print Chr(i And &HFF); " Key Down without Shift Down"
End If
End If
HookProc = CallNextHookEx(hHook, code, wParam, lParam)
End Function
'--------------------------------------------------------------------------------------------
'以下程式在Form
Private Sub Form_Load()
Call EnableHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call FreeHook
End Sub
相關資訊
文件出處
cww
