键盘钩子

dll   代码

--------------------------------------

library keyHook;



uses
  System.SysUtils,
  System.Classes,
  Unit4 in 'Unit4.pas';


{$R *.res}


begin


end.

-------------

unit Unit4;


interface
uses
  System.SysUtils,
  Windows,
  System.Classes;
const
  BUFFER_SIZE=16*1024;
  HOOK_MEM_FILENAME='MEM_FILE';
  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;
//清除键盘缓冲区
procedure cleankeyStr;export;
begin


  shared^.keycount:=0;
end;


//取得键值
function getKeyValuex(index:integer):char;export;
begin
  result:=shared^.keys[index];
end;


exports
  EnableKeyHook,
  DisableKeyHook,
  GetKeyCount,
  getKeyValuex,
  cleankeyStr;


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.

-------------------------------------测试dll的代码-----

unit Unit5;


interface


uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;


type
  TForm5 = class(TForm)
    btn_sethook: TButton;
    btn_canelhook: TButton;
    btn_readkey: TButton;
    btn_clearkey: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    procedure btn_sethookClick(Sender: TObject);
    procedure btn_canelhookClick(Sender: TObject);
    procedure btn_readkeyClick(Sender: TObject);
    procedure btn_clearkeyClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form5: TForm5;


implementation


{$R *.dfm}
function   EnableKeyHook : bool ; external 'D:\Documents\RAD Studio\Projects\Win32\Debug\keyHook.dll';
function  DisableKeyHook : bool ; external 'D:\Documents\RAD Studio\Projects\Win32\Debug\keyHook.dll';
function  GetKeyCount : integer ; external 'D:\Documents\RAD Studio\Projects\Win32\Debug\keyHook.dll';
function  getKeyValuex(i:integer) : char ; external  'D:\Documents\RAD Studio\Projects\Win32\Debug\keyHook.dll';
procedure  cleankeyStr;         external 'D:\Documents\RAD Studio\Projects\Win32\Debug\keyHook.dll';








procedure TForm5.btn_canelhookClick(Sender: TObject);
begin
  DisableKeyHook;
  btn_canelhook.Enabled:=false;
  btn_sethook.Enabled:=true;
   btn_readkey.Enabled:=false;
   btn_clearkey.Enabled:=false;
   Label1.Caption:='键盘钩子已经取消';
end;


procedure TForm5.btn_clearkeyClick(Sender: TObject);
begin
  memo1.Clear;
  cleankeyStr;
end;


procedure TForm5.btn_readkeyClick(Sender: TObject);
var
  i:integer;
begin
  memo1.Lines.Clear;
  for i := 0 to GetKeyCount-1 do
    memo1.Text:=memo1.Text+getKeyValuex(i);


end;


procedure TForm5.btn_sethookClick(Sender: TObject);
begin
   EnableKeyHook;
   btn_sethook.Enabled:=false;
   btn_canelhook.Enabled:=true;
   btn_readkey.Enabled:=true;
   btn_clearkey.Enabled:=true;
   Label1.Caption:='键盘钩子已经设置好了';
end;


procedure TForm5.FormCreate(Sender: TObject);
begin


end;


end.