用全局键盘钩子实现
用DELPHI编制Windows下的钩子函数
Windows消息管理机构提供了能使应用程序访问控制消息流所谓的钩子(HOOK)机制。钩子有多种，分别用于捕获某一特定类型或某一范围的消息。如：键盘消息，鼠标消息等。我们这里仅以键盘钩子的使用为例，讨论在DELPHI下怎样编写DLL程序和怎样在自己的程序中安装使用键盘钩子函数，并讨论了不同程序使用同一DLL文件时怎样共享数据。
一、 钩子过滤函数的编写说明
由于钩子过滤函数必须在独立的模块中，也就是说我们必须首先生成一个DLL框架，然后再在其中加入钩子函数代码以及其他相关函数代码。我们这里以键盘钩子过滤函数的编写为例来说明。具体步骤如下：
1、先生成一个DLL筐架
2、编写自己的键盘钩子过滤函数,钩子过滤函数必须是回调函数。
function KeyHookProc(iCode:Integer;wParam:WPARAM;lParam:LPARAM )
:LRESULT;
stdcall export
在生成的DLL框架中加入自己的键盘钩子处理函数处理键盘消息。代码如下：
...
if(iCode>=0) then
begin
Result:=0;
//初始化返回值
// 在这里加入自己的代码
end else
begin
Result:=CallNextHook(hOldKeyHook,iCode,wParam,lParam);
// hOldKeyHook是保存的原键盘过滤函数。
end;
3、 安装键盘钩子过滤函数
为安装一个钩子过滤函数应调用SetWindowsHookEx函数（适用于Windows3.0的SetWindowsHook钩子安装函数现在已经废弃不用）。该函数的原形如下：
HHOOK SetWindowsHookEx(
int idHook, // 安装的钩子子类型
HOOKPROC lpfn, // 钩子过滤函数地址
HINSTANCE hMod, // 任务句柄
DWORD dwThreadId // 钩子用于的目的
);
需要说明的是：通常应该调用MakeProcInstance函数以获取一个输出函数的前导码的入口地址，再将此地址作为SetWindowsHookEx的第二个参数lpfn。但由于Delphi提供了"灵巧调用(smart callback)"，使得MakeProcInstance可以省去，而直接将钩子过滤函数名用作入口地址。
这样当应用程序调用GetMessage或PeekMessage函数从消息队列中读消息或有按键消息(WM_KEYDOWN或WM_KEYUP)要处理时，系统就要调用钩子过滤函数KeyHookProc处理键盘消息。
4、 卸载钩子过滤函数。
当钩子函数不再需要时，应调用UnHookWindowsHookProc卸载安装的钩子以释放系统资源。
完整的程序清单如下：
Library KEYHOOK;
uses Windows;
const BUFFER_SIZE=16*1024;
const HOOK_MEM_FILENAME='SAMPLE KEY_HOOK_MEM_FILE';
const HOOK_MUTEX_NAME ='SAMPLE KEY_HOOK_MUTEX_NAME';
type
TShared=record
Keys : array[0..BUFFER_SIZE] of Char;
KeyCount : Integer;
end;
PShared=^TShared;
var
MemFile,HookMutex : THandle;
hOldKeyHook : HHook;
ProcSaveExit : Pointer;
Shared : PShared;
//键盘钩子过滤函数
function KeyHookProc(iCode: Integer;
wParam: WPARAM lParam: LPARAM)
:LRESULT;
stdcall;
export;
const KeyPressMask = $80000000;
begin
if iCode < 0 then
Result := CallNextHookEx(hOldKeyHook, iCode, wParam, lParam)
else
begin
if ((lParam and KeyPressMask)= 0) then
// 键按下
begin
Shared^.Keys[Shared^.KeyCount]:=Char(wParam and $00ff);
Inc(Shared^.KeyCount);
if Shared^.KeyCount>=BUFFER_SIZE-1 then
Shared^.KeyCount:=0;
end;
iCode:=-1;
Result := CallNextHookEx(hOldKeyHook, iCode, wParam, lParam);
end;
end;
// 设置钩子过滤函数
function EnableKeyHook : BOOL export;
begin
Shared^.KeyCount:=0;
//初始化键盘指针
if hOldKeyHook=0 then
begin
hOldKeyHook := SetWindowsHookEx(WH_KEYBOARD,
KeyHookProc,HInstance,0);
end;
Result := (hOldKeyHook <> 0);
end;
//撤消钩子过滤函数
function DisableKeyHook: BOOL export;
begin
if hOldKeyHook<> 0 then
begin
UnHookWindowsHookEx(hOldKeyHook);
// 解除 Keyboard Hook
hOldKeyHook:= 0;
Shared^.KeyCount:=0;
end;
Result := (hOldKeyHook = 0);
end;
//取得键盘缓冲区中击键的个数
function GetKeyCount :Integer export;
begin
Result:=Shared^.KeyCount;
end;
//取得键盘缓冲区的键
function GetKey(index:Integer) : Char export;
begin
Result:=Shared^.Keys[index];
end;
//清空键盘缓冲区
procedure ClearKeyString export;
begin
Shared^.KeyCount:=0;
end;
//DLL的退出处理过程
procedure KeyHookExit;
far;
begin
if hOldKeyHook <> 0 then
DisableKeyHook;
UnMapViewOfFile(Shared);
// 释放内存映象文件
CloseHandle(MemFile);
// 关闭映象文件
ExitProc := ProcSaveExit;
end;
exports // 定义输出函数
EnableKeyHook,
DisableKeyHook,
GetKeyCount,
ClearKeyString,
GetKey;
begin
// DLL 初始化部分
HookMutex:=CreateMutex(nil,True,HOOK_MUTEX_NAME);
// 通过建立内存映象文件以共享内存
MemFile:=OpenFileMapping(FILE_MAP_WRITE,False,HOOK_MEM_FILENAME);
if MemFile=0 then
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,
SizeOf(TShared) ,HOOK_MEM_FILENAME);
Shared:=MapViewOfFile(MemFile,File_MAP_WRITE,0,0,0);
ReleaseMutex(HookMutex);
CloseHandle(HookMutex);
ProcSaveExit := ExitProc;
// 保存DLL的ExitProc
ExitProc := @KeyHookExit;
// 设置DLL新的ExitProc
end.
// 源代码结束
二、 在自己的程序中使用编制好的键盘钩子过滤函数。
钩子函数编制好后，使用起来其实很简单：首先调用SetWindowsHookEx安装自己的钩子过滤函数，同时保存原先的钩子过滤函数地址。这时钩子函数就开始起作用了，它将按照你的要求处理键盘消息。程序运行完毕或不再需要监视键盘消息时，调用UnHookWindowsHookProc函数卸载所安装的钩子函数，同时恢复原来的钩子过滤函数地址。
下面就是使用在以上编制的钩子函数的例子：
unit Unit1;
interface
uses Windows,Messages,SysUtils,Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
bSetHook: TButton;
bCancelHook: TButton;
bReadKeys: TButton;
bClearKeys: TButton;
Panel2: TPanel;
procedure bSetHookClick(Sender: TObject);
procedure bCancelHookClick(Sender: TObject);
procedure bReadKeysClick(Sender: TObject);
procedure bClearKeysClick(Sender: TObject);
end;
var Form1: TForm1;
implementation
{$R *.DFM}
function EnableKeyHook : BOOL external 'KEYHOOK.DLL';
function DisableKeyHook : BOOL external 'KEYHOOK.DLL';
function GetKeyCount : Integer external 'KEYHOOK.DLL';
function GetKey(idx:Integer) : Char external 'KEYHOOK.DLL';
procedure ClearKeyString external 'KEYHOOK.DLL';
procedure TForm1.bSetHookClick(Sender: TObject);
// 设置键盘钩
begin
EnableKeyHook;
bSetHook.Enabled :=False;
bCancelHook.Enabled:=True;
bReadKeys.Enabled :=True;
bClearKeys.Enabled :=True;
Panel2.Caption:=' 键盘钩子已经设置';
end;
procedure TForm1.bCancelHookClick(Sender: TObject);
// 卸载键盘钩子
begin
DisableKeyHook;
bSetHook.Enabled :=True;
bCancelHook.Enabled:=False;
bReadKeys.Enabled :=False;
bClearKeys.Enabled :=False;
Panel2.Caption:=' 键盘钩子没有设置';
end;
procedure TForm1.bReadKeysClick(Sender: TObject);
// 取得击键的历史记录
var i:Integer;
begin
Memo1.Lines.Clear;
// 在Memo1中显示击键历史记录
for i:=0 to GetKeyCount-1do
Memo1.Text:=Memo1.Text+GetKey(i);
end;
procedure TForm1.bClearKeysClick(Sender: TObject);
// 清除击键历史记录
begin
Memo1.Clear;
ClearKeyString;
end;
end.
// 源代码结束
