DELPHI使用键盘钩子

原作者: [db:作者] 来自: [db:来源] 收藏邀请

小读了一下《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.