library kbdhook;  
uses sysutils, windows, messages;  
const  
swm_kbdhook = 'swm_kbdhook';  
var  
wm_kbdhook : integer = 0;  
var  
hookhandle : thandle = 0;  
  
function keyboardproc(  
code: integer; // hook code  
wparam: wparam; // virtual-key code  
lparam: lparam): // keystroke-message information  
lresult stdcall;  
begin  
if code < 0 then  
result := callnexthookex( hookhandle, code, wparam, lparam )  
else begin  
postmessage( hwnd_broadcast, wm_kbdhook, wparam, lparam );  
result := 0  
end;  
end;  
  
function hookkeyboard( hook : boolean ) : boolean; stdcall;  
begin  
result := false;  
if hook then begin  
if hookhandle = 0 then  
hookhandle := setwindowshookex( wh_keyboard, keyboardproc, hinstance,  
0 );  
result := ( hookhandle <> 0 );  
end else begin  
if hookhandle <> 0 then begin  
unhookwindowshookex( hookhandle );  
hookhandle := 0;  
result := true;  
end;  
end;  
end;  
  
exports  
keyboardproc index 1,  
hookkeyboard index 2;  
  
begin  
wm_kbdhook := registerwindowmessage( swm_kbdhook );  
end.  
  
// ---------------------------------------------------------------------  
  
unit unit1;  
  
interface  
  
uses  
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,  
stdctrls;  
  
const  
swm_kbdhook = 'swm_kbdhook';  
  
var  
wm_kbdhook : integer = 0;  
  
type  
tform1 = class(tform)  
checkbox1: tcheckbox;  
memo1: tmemo;  
procedure checkbox1click(sender: tobject);  
procedure formdestroy(sender: tobject);  
procedure formcreate(sender: tobject);  
private  
{ private declarations }  
procedure apponmessage( var msg: tmsg; var handled: boolean);  
public  
{ public declarations }  
end;  
  
var  
form1: tform1;  
  
implementation  
  
{$r *.dfm}  
  
function keyboardproc(  
code: integer; // hook code  
wparam: wparam; // virtual-key code  
lparam: lparam): // keystroke-message information  
lresult stdcall;  
external 'kbdhook.dll' index 1;  
  
function hookkeyboard(  
hook : boolean ) : boolean; stdcall;  
external 'kbdhook.dll' index 2;  
  
procedure tform1.apponmessage( var msg: tmsg; var handled: boolean);  
begin  
if msg.message = wm_kbdhook then begin  
memo1.lines.add( format( 'keycode=%d flags=%d', [msg.wparam,  
msg.lparam] ) );  
handled := true;  
end;  
end;  
  
procedure tform1.checkbox1click(sender: tobject);  
begin  
if not hookkeyboard( ( sender as tcheckbox ).checked )  
then caption := 'error';  
end;  
  
procedure tform1.formdestroy(sender: tobject);  
begin  
hookkeyboard( false );  
end;  
  
procedure tform1.formcreate(sender: tobject);  
begin  
wm_kbdhook := registerwindowmessage( swm_kbdhook );  
application.onmessage := apponmessage;  
end;  
  
end.