利用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建立消息回放鉤子，
當每一次系統可以回放消息時就會調用鉤子函數，在鉤子函數中就可以從消息隊列中取出原來紀錄的消息返回給系統。
這樣就實現了鼠標鍵盤操作的紀錄和回放。
