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
|