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.

Автор: Тенцер А.Л.
icq 15925834

Получить ссылку на материал