KeyBoard Key in的习惯分析(JournalRecord Hook)

来源:cww

如果说，我们想得知某些键被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_KEYDOWN = &H100
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