深入浅出HOOKS（下）
利用VB建立鼠标键盘操作回放
很多的教学软件或系统监视软件可以自动记录回放用户的输入文字或点击按钮等操作操作，这个功能的实现是使用
了Windows的Hook函数。本文介绍如何通过使用VB来实现鼠标键盘操作的纪录和回放。
Windows提供API函数SetwindowsHookEx来建立一个Hook，通过这个函数可以将一个程序添加到Hook链中监视Windows
消息，函数语法为：
Public Declare Function SetWindowsHookEx Lib "user32" _
用消息拦截技术制作系统日志
康帕斯（中国）国际信息服务有限公司 马文骞
01-6-7 下午 03:33:05
--------------------------------------------------------------------------------
能够完整记录电脑使用情况的日志文件在 Windows系统安全管理方面的作用是不可低估的。本文介绍了利用消息拦截技术制作日志文件的方法，其中的关键函数是一个未公开的 API系统调用。
一、利用钩子（Hook）拦截系统消息
日志文件对于一个大企业内部网络的维护与管理是至关重要的。另外还有许多其它场合也离不开日志的使用，例如：多人共享一台电脑，或在家庭中要记录儿童使用电脑的细节，等等。
日志程序若想完整记录电脑运行期间有哪些软件启动过、各使用了多长时间、以及使用浏览器访问互联网的情况等，必须对系统级消息进行拦截。RegisterShellHook是一个未公开的 API系统函数，它可以帮助日志程序在整个 Windows系统范围内感知到其它窗体的创建、激活或关闭等消息，而且不要求这些窗体与日志程序有父子关系，哪怕是 Windows最高级别的窗体也可以。RegisterShellHook 调用方法为：
Public Declare Function RegisterShellHook Lib "Shell32" Alias "#181" _
(ByVal hwnd As Long, ByVal nAction As Long) As Long
其中参数hwnd为日志程序的句柄，参数 nAction为所要进行操作的代码。具体的调用细节参见下面的例子及其注释。
二、将日志程序隐藏起来
把日志程序的Visible属性设为False当然是必要的一步。然后是 ShowInTaskbar属性也设为 False，以便其在 Windows的任务栏中不出现。最后，为了在 CTRL+ALT+DEL 所弹出的列表中隐藏日志程序，需要调用RegisterServiceProcess函数：
Public Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
其中参数dwType是操作代码，值“1”表示从CTRL+ALT+DEL列表中去除，值“0”表示在列表中恢复；参数 dwProcessID是要在列表中去除或恢复的进程标识，可以用GetCurrentProcessId() API 函数得到日志程序的进程标识，也可以用更简便的方法，即把 dwProcessID参数置为空值，其含义是用当前程序的进程标识作为参数（见下例）。
另外，为了让日志程序在 Windows每次启动时都能自动运行，需要修改注册表，即在注册表的下述位置新建一个以日志程序的路径及名称为值的“串值”：
/HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersion/Run
此外，产生的日志文件也应妥为隐藏，最好用 Winsock控件随时向服务器传送。
为了简洁，下面的例子仅将日志文件放在了根目录，并且略去了用TCP/IP传送文件的代码。
三、一个完整的例子
下面的代码虽然短小，却是一个完整的能自我隐藏的日志程序（用 VB6.0实现，在 Win98下测试通过）。
' 窗体部分的代码（Form1.frm）
Option Explicit
Private Sub Form_Load()
Dim tmp As Long
' 将日志程序的名称从 CTRL+ALT+DEL 列表中清除
tmp = RegisterServiceProcess(ByVal 0&, 1)
Timer1.Interval = 60000 ' 定时器的作用是每隔一分钟将日志存盘
' 定义一个新的系统级的消息类型
Msg_ID = RegisterWindowMessage("SHELLHOOK")
Call RegisterShellHook(hwnd, 1) ' 调用未公开的函数（进行注册）
' 实施拦截：在存储了原入口地址的同时，将新地址指向自定义的函数WindowProc
Original = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim tmp As Long
Call RegisterShellHook(hwnd, 0) ' 调用未公开的函数（取消注册）
tmp = SetWindowLong(hwnd, GWL_WNDPROC, Original) ' 将入口地址还原
End Sub
Private Sub Timer1_Timer()
If Len(Text1.Text) > 0 Then
Open "C:/SystemLog.Sys" For Append As #1 ' 以“添加”方式打开日志
Print #1, Text1.Text ' 日志自动存盘
Text1.Text = ""
Close #1
End If
End Sub
' 模块部分的代码（模块1.bas）
Public Declare Function RegisterShellHook Lib "Shell32" Alias "#181" _
(ByVal hwnd As Long, ByVal nAction As Long) As Long
Public Declare Function RegisterWindowMessage Lib "user32" Alias _
"RegisterWindowMessageA" (ByVal lpString As String) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, ByVal lParam As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Const HSHELL_WINDOWCREATED = 1 ' 系统级的窗体被创建
Const HSHELL_WINDOWDESTROYED = 2 ' 系统级的窗体即将被关闭
'Const HSHELL_ACTIVATESHELLWINDOW = 3 ' SHELL 的主窗体将被激活（本例未用）
Const HSHELL_WINDOWACTIVATED = 4 ' 系统级的窗体被激活
'Const HSHELL_GETMINRECT = 5 ' 窗体被最大化或最小化（本例未用）
'Const HSHELL_REDRAW = 6 ' Windows 任务栏被刷新（本例未用）
'Const HSHELL_TASKMAN = 7 ' 任务列表的内容被选中（本例未用）
'Const HSHELL_LANGUAGE = 8 ' 中英文切换或输入法切换（本例未用）
Public Const GWL_WNDPROC = -4 ' 该索引用来创建窗口类的子类
Public Msg_ID As Long, Original As Long
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal _
wParam As Long, ByVal lParam As Long) As Long ' 回调函数
Dim tmp1 As String, tmp2 As String, i As Long
If uMsg = Msg_ID Then
tmp1 = String(200, "*")
i = GetWindowText(lParam, tmp1, 200) ' 取窗体的标题
If i > 0 Then tmp1 = Left(tmp1, i) Else tmp1 = "未命名"
tmp1 = tmp1 + " " + Str(Date) + " " + Str(Time) + vbCrLf ' 加入日期
' 下面对窗体句柄值进行格式化的目的是为了日志文件在视觉上更美观
tmp2 = Format(lParam, "000000")
If Right(Form1.Text1, 2) <> vbCrLf Then tmp2 = vbCrLf + tmp2
Select Case wParam
Case HSHELL_WINDOWCREATED
Form1.Text1 = Form1.Text1 + tmp2 + " 创建：" + tmp1
Case HSHELL_WINDOWDESTROYED
Form1.Text1 = Form1.Text1 + tmp2 + " 关闭：" + tmp1
Case HSHELL_WINDOWACTIVATED
Form1.Text1 = Form1.Text1 + tmp2 + " 激活：" + tmp1
' 为了程序简洁，本例仅处理“创建”、“激活”和“关闭”这三个消息，
' 其实就生成日志文件的目的，上述三个消息已基本够用。
' Case ...
' ...
End Select
Else
' 使用已被存储下来的原入口地址
WindowProc = CallWindowProc(Original, hwnd, uMsg, wParam, lParam)
End If
End Function
下面列出的即为上述日志程序所产生的日志文件（长约十分钟的片段）。从中可以看出在该时间段内的电脑使用情况：曾拨号上网、浏览过“计算机世界”、收过邮件、访问过注册表等。左列的数字是相应窗体的句柄。
002624 激活：Project1 - Microsoft Visual Basic [设计]
002624 关闭：Microsoft Visual Basic [设计]
001692 创建：正在连接到 95963
001692 激活：正在连接到 95963
003512 关闭：Hotmail - 通行全球的免费 Web 电子邮件 - Microsoft Internet Explorer
001880 创建：未命名 01-6-6 16:01:25
001880 激活：未命名 01-6-6 16:01:25
001880 激活：计算机世界网-应用与方案-首页 - Microsoft Internet Explorer
001880 激活：计算机世界网-应用与方案-应用编程 - Microsoft Internet Explorer
003488 创建：Microsoft Internet Explorer 01-6-6 16:07:40
003488 激活：Microsoft Internet Explorer 01-6-6 16:07:41
003488 关闭：计算机世界网-用屏幕取词技术实现动态标注 - Microsoft Internet Explorer
001880 激活：计算机世界网-e海航标-首页 - Microsoft Internet Explorer
001880 关闭：计算机世界网-e海航标-首页 - Microsoft Internet Explorer
001132 激活：浏览 - C:/
001132 关闭：浏览 - C:/
002772 创建：Outlook Express 01-6-6 16:10:41
002772 激活：Outlook Express 01-6-6 16:10:41
002772 激活：收件箱 - Outlook Express
002772 关闭：收件箱 - Outlook Express
003920 关闭：浏览 - 我的电脑
000640 创建：注册表编辑器
000640 激活：注册表编辑器
000640 关闭：注册表编辑器
003756 创建：未命名 01-6-6 16:11:30
003756 关闭：未命名 01-6-6 16:11:30
001328 创建：网络监视器
001328 激活：网络监视器
001328 激活：网络监视器 - 0 连接到 //CD_PROGRAM
001328 关闭：网络监视器 - 0 连接到 //CD_PROGRAM
002700 关闭：连接到 95963
001804 关闭：未命名 01-6-6 16:13:13
Platform SDK: Interprocess Communications
Monitoring System Events
The following example uses a variety of thread-specific hook procedures to monitor the system for events affecting a thread. It demonstrates how to process events for the following types of hook procedures:
WH_CALLWNDPROC
WH_CBT
WH_DEBUG
WH_GETMESSAGE
WH_KEYBOARD
WH_MOUSE
WH_MSGFILTER
The user can install and remove a hook procedure by using the menu. When a hook procedure is installed and an event that is monitored by the procedure occurs, the procedure writes information about the event to the client area of the application's main window.
#define NUMHOOKS 7
// Global variables
typedef struct _MYHOOKDATA
{
int nType;
HOOKPROC hkprc;
HHOOK hhook;
} MYHOOKDATA;
MYHOOKDATA myhookdata[NUMHOOKS];
LRESULT WINAPI MainWndProc(HWND hwndMain, UINT uMsg, WPARAM wParam,
LPARAM lParam)
{
static BOOL afHooks[NUMHOOKS];
int index;
static HMENU hmenu;
switch (uMsg)
{
case WM_CREATE:
// Save the menu handle.
hmenu = GetMenu(hwndMain);
// Initialize structures with hook data. The menu-item
// identifiers are defined as 0 through 6 in the
// header file. They can be used to identify array
// elements both here and during the WM_COMMAND
// message.
myhookdata[IDM_CALLWNDPROC].nType = WH_CALLWNDPROC;
myhookdata[IDM_CALLWNDPROC].hkprc = CallWndProc;
myhookdata[IDM_CBT].nType = WH_CBT;
myhookdata[IDM_CBT].hkprc = CBTProc;
myhookdata[IDM_DEBUG].nType = WH_DEBUG;
myhookdata[IDM_DEBUG].hkprc = DebugProc;
myhookdata[IDM_GETMESSAGE].nType = WH_GETMESSAGE;
myhookdata[IDM_GETMESSAGE].hkprc = GetMsgProc;
myhookdata[IDM_KEYBOARD].nType = WH_KEYBOARD;
myhookdata[IDM_KEYBOARD].hkprc = KeyboardProc;
myhookdata[IDM_MOUSE].nType = WH_MOUSE;
myhookdata[IDM_MOUSE].hkprc = MouseProc;
myhookdata[IDM_MSGFILTER].nType = WH_MSGFILTER;
myhookdata[IDM_MSGFILTER].hkprc = MessageProc;
// Initialize all flags in the array to FALSE.
memset(afHooks, FALSE, sizeof(afHooks));
return 0;
case WM_COMMAND:
switch (LOWORD(wParam))
{
// The user selected a hook command from the menu.
case IDM_CALLWNDPROC:
case IDM_CBT:
case IDM_DEBUG:
case IDM_GETMESSAGE:
case IDM_KEYBOARD:
case IDM_MOUSE:
case IDM_MSGFILTER:
// Use the menu-item identifier as an index
// into the array of structures with hook data.
index = LOWORD(wParam);
// If the selected type of hook procedure isn't
// installed yet, install it and check the
// associated menu item.
if (!afHooks[index])
{
myhookdata[index].hhook = SetWindowsHookEx(
myhookdata[index].nType,
myhookdata[index].hkprc,
(HINSTANCE) NULL, GetCurrentThreadId());
CheckMenuItem(hmenu, index,
MF_BYCOMMAND | MF_CHECKED);
afHooks[index] = TRUE;
}
// If the selected type of hook procedure is
// already installed, remove it and remove the
// check mark from the associated menu item.
else
{
UnhookWindowsHookEx(myhookdata[index].hhook);
CheckMenuItem(hmenu, index,
MF_BYCOMMAND | MF_UNCHECKED);
afHooks[index] = FALSE;
}
default:
return (DefWindowProc(hwndMain, uMsg, wParam,
lParam));
}
break;
//
// Process other messages.
//
default:
return DefWindowProc(hwndMain, uMsg, wParam, lParam);
}
return NULL;
}
/****************************************************************
WH_CALLWNDPROC hook procedure
****************************************************************/
LRESULT WINAPI CallWndProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szCWPBuf[256];
CHAR szMsg[16];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process message
return CallNextHookEx(myhookdata[CALLWNDPROC].hhook, nCode,
wParam, lParam);
// Call an application-defined function that converts a message
// constant to a string and copies it to a buffer.
LookUpTheMessage((PMSG) lParam, szMsg);
hdc = GetDC(hwndMain);
switch (nCode)
{
case HC_ACTION:
cch = wsprintf(szCWPBuf,
"CALLWNDPROC - tsk: %ld, msg: %s, %d times ",
wParam, szMsg, c++);
TextOut(hdc, 2, 15, szCWPBuf, cch);
break;
default:
break;
}
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[CALLWNDPROC].hhook, nCode,
wParam, lParam);
}
/****************************************************************
WH_GETMESSAGE hook procedure
****************************************************************/
LRESULT CALLBACK GetMsgProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szMSGBuf[256];
CHAR szRem[16];
CHAR szMsg[16];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process message
return CallNextHookEx(myhookdata[GETMESSAGE].hhook, nCode,
wParam, lParam);
switch (nCode)
{
case HC_ACTION:
switch (wParam)
{
case PM_REMOVE:
lstrcpy(szRem, "PM_REMOVE");
break;
case PM_NOREMOVE:
lstrcpy(szRem, "PM_NOREMOVE");
break;
default:
lstrcpy(szRem, "Unknown");
break;
}
// Call an application-defined function that converts a
// message constant to a string and copies it to a
// buffer.
LookUpTheMessage((PMSG) lParam, szMsg);
hdc = GetDC(hwndMain);
cch = wsprintf(szMSGBuf,
"GETMESSAGE - wParam: %s, msg: %s, %d times ",
szRem, szMsg, c++);
TextOut(hdc, 2, 35, szMSGBuf, cch);
break;
default:
break;
}
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[GETMESSAGE].hhook, nCode,
wParam, lParam);
}
/****************************************************************
WH_DEBUG hook procedure
****************************************************************/
LRESULT CALLBACK DebugProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szBuf[128];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process message
return CallNextHookEx(myhookdata[DEBUG].hhook, nCode,
wParam, lParam);
hdc = GetDC(hwndMain);
switch (nCode)
{
case HC_ACTION:
cch = wsprintf(szBuf,
"DEBUG - nCode: %d, tsk: %ld, %d times ",
nCode,wParam, c++);
TextOut(hdc, 2, 55, szBuf, cch);
break;
default:
break;
}
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[DEBUG].hhook, nCode, wParam,
lParam);
}
/****************************************************************
WH_CBT hook procedure
****************************************************************/
LRESULT CALLBACK CBTProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szBuf[128];
CHAR szCode[128];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process message
return CallNextHookEx(myhookdata[CBT].hhook, nCode, wParam,
lParam);
hdc = GetDC(hwndMain);
switch (nCode)
{
case HCBT_ACTIVATE:
lstrcpy(szCode, "HCBT_ACTIVATE");
break;
case HCBT_CLICKSKIPPED:
lstrcpy(szCode, "HCBT_CLICKSKIPPED");
break;
case HCBT_CREATEWND:
lstrcpy(szCode, "HCBT_CREATEWND");
break;
case HCBT_DESTROYWND:
lstrcpy(szCode, "HCBT_DESTROYWND");
break;
case HCBT_KEYSKIPPED:
lstrcpy(szCode, "HCBT_KEYSKIPPED");
break;
case HCBT_MINMAX:
lstrcpy(szCode, "HCBT_MINMAX");
break;
case HCBT_MOVESIZE:
lstrcpy(szCode, "HCBT_MOVESIZE");
break;
case HCBT_QS:
lstrcpy(szCode, "HCBT_QS");
break;
case HCBT_SETFOCUS:
lstrcpy(szCode, "HCBT_SETFOCUS");
break;
case HCBT_SYSCOMMAND:
lstrcpy(szCode, "HCBT_SYSCOMMAND");
break;
default:
lstrcpy(szCode, "Unknown");
break;
}
cch = wsprintf(szBuf, "CBT - nCode: %s, tsk: %ld, %d times ",
szCode, wParam, c++);
TextOut(hdc, 2, 75, szBuf, cch);
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[CBT].hhook, nCode, wParam,
lParam);
}
/****************************************************************
WH_MOUSE hook procedure
****************************************************************/
LRESULT CALLBACK MouseProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szBuf[128];
CHAR szMsg[16];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process the message
return CallNextHookEx(myhookdata[MOUSE].hhook, nCode,
wParam, lParam);
// Call an application-defined function that converts a message
// constant to a string and copies it to a buffer.
LookUpTheMessage((PMSG) lParam, szMsg);
hdc = GetDC(hwndMain);
cch = wsprintf(szBuf,
"MOUSE - nCode: %d, msg: %s, x: %d, y: %d, %d times ",
nCode, szMsg, LOWORD(lParam), HIWORD(lParam), c++);
TextOut(hdc, 2, 95, szBuf, cch);
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[MOUSE].hhook, nCode, wParam,
lParam);
}
/****************************************************************
WH_KEYBOARD hook procedure
****************************************************************/
LRESULT CALLBACK KeyboardProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szBuf[128];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process message
return CallNextHookEx(myhookdata[KEYBOARD].hhook, nCode,
wParam, lParam);
hdc = GetDC(hwndMain);
cch = wsprintf(szBuf, "KEYBOARD - nCode: %d, vk: %d, %d times ",
nCode, wParam, c++);
TextOut(hdc, 2, 115, szBuf, cch);
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[KEYBOARD].hhook, nCode, wParam,
lParam);
}
/****************************************************************
WH_MSGFILTER hook procedure
****************************************************************/
LRESULT CALLBACK MessageProc(int nCode, WPARAM wParam, LPARAM lParam)
{
CHAR szBuf[128];
CHAR szMsg[16];
CHAR szCode[32];
HDC hdc;
static int c = 0;
int cch;
if (nCode < 0) // do not process message
return CallNextHookEx(myhookdata[MSGFILTER].hhook, nCode,
wParam, lParam);
switch (nCode)
{
case MSGF_DIALOGBOX:
lstrcpy(szCode, "MSGF_DIALOGBOX");
break;
case MSGF_MENU:
lstrcpy(szCode, "MSGF_MENU");
break;
case MSGF_SCROLLBAR:
lstrcpy(szCode, "MSGF_SCROLLBAR");
break;
default:
wsprintf(szCode, "Unknown: %d", nCode);
break;
}
// Call an application-defined function that converts a message
// constant to a string and copies it to a buffer.
LookUpTheMessage((PMSG) lParam, szMsg);
hdc = GetDC(hwndMain);
cch = wsprintf(szBuf,
"MSGFILTER nCode: %s, msg: %s, %d times ",
szCode, szMsg, c++);
TextOut(hdc, 2, 135, szBuf, cch);
ReleaseDC(hwndMain, hdc);
return CallNextHookEx(myhookdata[MSGFILTER].hhook, nCode,
wParam, lParam);
}
Built on Thursday, October 12, 2000
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
其中参数idHook指定建立的监视函数类型。通过Windows MSDN帮助可以看到，SetwindowsHookEx函数提供15种不同
的消息监视类型，在这里我们将使用WH_JOURNALRECORD和WH_JOURNALPLAYBACK来监视键盘和鼠标操作。参数lpfn指定消
息函数，在相应的消息产生后，系统会调用该函数并将消息值传递给该函数供处理。函数的一般形式为：
Hookproc (code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
其中code为系统指示标记，wParam和lParam为附加参数，根据不同的消息监视类型而不同。只要在程序中建立这样
一个函数再通过SetwindowsHookEx函数将它加入到消息监视链中就可以处理消息了。
在不需要监视系统消息时需要调用提供UnHookWindowsHookEx来解除对消息的监视。
WH_JOURNALRECORD和WH_JOURNALPLAYBACK类型是两种相反的Hook类型，前者获得鼠标、键盘动作消息，后者回放鼠
标键盘消息。所以在程序中我们需要建立两个消息函数，一个用于纪录鼠标键盘操作并保存到一个数组中，另一个用于
将保存的操作返给系统回放。
下面是具体的程序实现：首先建立一个新工程，在Form1中加入三个CommandButton控件用于控制消息钩子，另外还
可以增加若干Command或者TextBox控件用于检验操作回放的效果。然后在工程中增加一个模块文件，在模块中加入以下
定义和代码:
Option Explicit
Public Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
Public Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
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 Sub CopyMemoryT2H Lib "kernel32" _
Alias "RtlMoveMemory" _
(ByVal Dest As Long, _
Source As EVENTMSG, _
ByVal Length As Long)
Public Declare Sub CopyMemoryH2T Lib "kernel32" _
Alias "RtlMoveMemory" _
(Dest As EVENTMSG, _
ByVal Source As Long, _
ByVal Length As Long)
Public Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Const WH_JOURNALPLAYBACK = 1
Public Const WH_JOURNALRECORD = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
Public Const HC_SKIP = 2
Public Const HC_GETNEXT = 1
Public Const HC_ACTION = 0
Public EventArr(1000) As EVENTMSG
Public EventLog As Long
Public PlayLog As Long
Public hHook As Long
Public hPlay As Long
Public recOK As Long
Public canPlay As Long
Public bDelay As Boolean
Public Function HookProc(ByVal iCode As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim Result As Long
recOK = 1
Result = 0
If iCode < 0 Then 'iCode小于0必须直接调用下一个消息钩子函数
Result = CallNextHookEx(hHook, iCode, wParam, lParam)
ElseIf iCode = HC_SYSMODALON Then '不允许纪录
recOK = 0
ElseIf iCode = HC_SYSMODALOFF Then '允许纪录
recOK = 1
ElseIf ((recOK > 0) And (iCode = HC_ACTION)) Then
'将消息纪录在纪录队列中
CopyMemoryH2T EventArr(EventLog), lParam, Len(EventArr(EventLog))
EventLog = EventLog + 1
If EventLog >= 1000 Then
'当纪录大于1000后释放消息钩子
UnhookWindowsHookEx hHook
End If
End If
HookProc = Result
End Function
Public Function PlaybackProc(ByVal iCode As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim Result As Long
canPlay = 1
Result = 0
If iCode < 0 Then 'iCode小于0必须直接调用下一个消息钩子函数
Result = CallNextHookEx(hPlay, iCode, wParam, lParam)
ElseIf iCode = HC_SYSMODALON Then '不允许回放
canPlay = 0
ElseIf iCode = HC_SYSMODALOFF Then '允许回放
canPlay = 1
ElseIf ((canPlay = 1) And (iCode = HC_GETNEXT)) Then
If bDelay Then
bDelay = False
Result = 50
End If
'从纪录队列中取出消息并赋予lParam指针指向的EVENTMSG区域
CopyMemoryT2H lParam, EventArr(PlayLog), Len(EventArr(EventLog))
ElseIf ((canPlay = 1) And (iCode = HC_SKIP)) Then
bDelay = True
PlayLog = PlayLog + 1
End If
If PlayLog >= EventLog Then
UnhookWindowsHookEx hPlay
End If
PlaybackProc = Result
End Function
在Form1的代码窗口中加入以下代码：
Option Explicit
Private Sub Command1_Click()
EventLog = 0
hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, _
App.hInstance, 0)
Command2.Enabled = True
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
UnhookWindowsHookEx hHook
hHook = 0
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = True
End Sub
Private Sub Command3_Click()
PlayLog = 0
hPlay = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf PlaybackProc, _
App.hInstance, 0)
Command3.Enabled = False
End Sub
Private Sub Form_Load()
Command1.Caption = "纪录"
Command2.Caption = "停止"
Command3.Caption = "回放"
Command2.Enabled = False
Command3.Enabled = False
End Sub
运行程序，点击“纪录”按钮，然后在TextBox中输入一些文字或者在窗口上移动光标后再按“停止”键停止消息
纪录，然后按“回放”按钮，可以看到刚才鼠标键盘的操作被丝毫不差的回放了出来。
从上面的程序可以看到：通过WH_JOURNALRECORD可以建立一个鼠标键盘消息钩子，当每一个鼠标键盘消息产生时被
钩子函数被调用。在钩子函数中可以将消息保存在消息事件队列中。然后通过WH_JOURNALPLAYBACK建立消息回放钩子，
当每一次系统可以回放消息时就会调用钩子函数，在钩子函数中就可以从消息队列中取出原来纪录的消息返回给系统。
这样就实现了鼠标键盘操作的纪录和回放。