Delphi 键盘勾子DLL演示代码

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
   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;

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
   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.

主程序代码：
-------------------------------------------------

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.