小读了一下《Delphi下深入Windows核心编程》感觉里面的东西写得还算可以,至少有学到东西
于是整理了一下书中的代码,并加上注注释发上来
首先是最重要的键盘钩子使用的DLL:
- unit UnitDll;
- interface
- uses Windows;
- const BUFFER_SIZE = 16 * 1024; // 文件映射到内存的大小
- const HOOK_MEM_FILENAME = 'MEM_FILE'; // 映像文件名
- const HOOK_MUTEX_NAME = 'MUTEX_NAME'; // 互斥名
- type
- // 共享结构
- TShared = record
- Keys: array[0..BUFFER_SIZE] of Char;
- KeyCount: Integer;
- end;
- // 共享结构指针
- PShared = ^TShared;
- var
- MemFile, HookMutex: THandle; // 文件句柄和互斥句柄
- hOldKeyHook: HHook; // 钩子变量
- Shared: PShared; // 共享变量
- implementation
- // 重要:键盘钩子回调
- 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;
- result:=0;
- end;
- end;
- // 安装钩子
- function EnableKeyHook: BOOL; export;
- begin
- Shared^.KeyCount := 0;
- if hOldKeyHook = 0 then
- begin
- // 设置钩子过滤
- {WH_KEYBOARD: 安装的是键盘钩子 KeyHookProc: 消息回调, HInstance: 回调函数实例 线程ID}
- hOldKeyHook := SetWindowsHookEx(WH_KEYBOARD, KeyHookProc, HInstance, 0);
- end;
- Result := (hOldKeyHook <> 0);
- end;
- {撤消钩子过滤函数}
- function DisableKeyHook: BOOL; export;
- begin
- if hOldKeyHook <> 0 then
- begin
- UnHookWindowsHookEx(hOldKeyHook);
- hOldKeyHook := 0;
- Shared^.KeyCount := 0;
- end;
- Result := (hOldKeyHook = 0);
- end;
- // 得到获得多少按键
- function GetKeyCount: Integer; export;
- begin
- Result := Shared^.KeyCount;
- end;
- // 得到第I个按键
- function GetKey(index: Integer): Char; export;
- begin
- Result := Shared^.Keys[index];
- end;
- // 清空按键
- procedure ClearKeyString; export;
- begin
- Shared^.KeyCount := 0;
- end;
- // 导出函数列表
- exports
- EnableKeyHook,
- DisableKeyHook,
- GetKeyCount,
- ClearKeyString,
- GetKey;
- initialization
- // 创建互斥变量,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);
- finalization
- // 撤消钩子过滤
- if hOldKeyHook <> 0 then
- DisableKeyHook;
- // 释放映射
- UnMapViewOfFile(Shared);
- // 关闭映像文件
- CloseHandle(MemFile);
- end.
这个看懂了之后就可以直接写个CLIENT调用了
- unit Unit2;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, ExtCtrls;
- type
- TForm1 = class(TForm)
- Memo1: TMemo;
- 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 - 1 do
- Memo1.Text := Memo1.Text + GetKey(i);
- end;
- procedure TForm1.bClearKeysClick(Sender: TObject);
- begin
- Memo1.Clear;
- ClearKeyString;
- end;
- end.