Пример:
Код библиотеки:
-----------------------------------------------------------------------
library keyboardhook;
uses
sysutils,
windows,
messages,
forms;
const
mmfname:pchar='keys';
type
pglobaldlldata=^tglobaldlldata;
tglobaldlldata=packed record
syshook:hwnd; //дескриптор установленной ловушки
myappwnd:hwnd; //дескриптор нашего приложения
end;
var
globaldata:pglobaldlldata;
mmfhandle:thandle;
wm_mykeyhook:cardinal;
function keyboardproc(code:integer;wparam:word;lparam:longint):longint;stdcall;
var
appwnd:hwnd;
begin
if code < 0 then
begin
result:=callnexthookex(globaldata^.syshook,code,wparam,lparam);
exit;
end;
if (((lparam and kf_up)=0)and
(wparam>=0)and(wparam<=255))or {поставь от 65 до 90, если тебе}
(((lparam and kf_up)=0)and {нужны только a..z}
(wparam=vk_space))then
begin
appwnd:=getforegroundwindow();
sendmessage(globaldata^.myappwnd,wm_mykeyhook,wparam,appwnd);
end;
callnexthookex(globaldata^.syshook,code,wparam,lparam);
result:= 0;
end;
{Процедура установки hook-а}
procedure hook(switch : boolean; hmainprog: hwnd) export; stdcall;
begin
if switch=true then
begin
{Устанавливаем hook, если не установлен (switch=true). }
globaldata^.syshook := setwindowshookex(wh_keyboard, @keyboardproc, hinstance, 0);
globaldata^.myappwnd:= hmainprog;
end
else
unhookwindowshookex(globaldata^.syshook)
end;
procedure openglobaldata();
begin
{регестрируем свой тип сообщения в системе}
wm_mykeyhook:= registerwindowmessage('wm_mykeyhook');
{получаем объект файлового отображения}
mmfhandle:= createfilemapping(invalid_handle_value, nil, page_readwrite,0,sizeof(tglobaldlldata),mmfname);
{отображаем глобальные данные на АП вызывающего процесса и получаем указатель
на начало выделенного пространства}
globaldata:= mapviewoffile(mmfhandle,file_map_all_access,0,0,sizeof(tglobaldlldata));
if globaldata=nil then
begin
closehandle(mmfhandle);
exit;
end;
end;
procedure closeglobaldata();
begin
unmapviewoffile(globaldata);
closehandle(mmfhandle);
end;
procedure dllentrypoint(dwreason: dword); stdcall;
begin
case dwreason of
dll_process_attach: openglobaldata;
dll_process_detach: closeglobaldata;
end;
end;
exports hook;
begin
dllproc:= @dllentrypoint;
{вызываем назначенную процедуру для отражения факта присоединения данной
библиотеки к процессу}
dllentrypoint(dll_process_attach);
end.
----------------------------------------------------------------------
Программа:
unit unit11;
interface
uses
windows, messages, sysutils, {variants, }classes, graphics, controls, forms,
dialogs, imglist, comctrls, toolwin, stdctrls, extctrls, menus;
type
tform1 = class(tform)
label1: tlabel;
button1: tbutton;
button2: tbutton;
label2: tlabel;
procedure formclose(sender: tobject; var action: tcloseaction);
procedure button1click(sender: tobject);
procedure button2click(sender: tobject);
private
{изменяем стандартную процедуру}
procedure wndproc(var msg: tmessage); override;
public
{ public declarations }
end;
var
form1: tform1;
wndflag: hwnd; // дескриптор последнего окна
keys: string; // нажатые клавишы
hdll: thandle; // дескриптор загружаемой библиотеки
wm_mykeyhook: cardinal; // новое сообщение
implementation
{$r *.dfm}
procedure init;
var
hook: procedure (switch : boolean; hmainprog: hwnd) stdcall;
begin
{посылаю своему окну сообщение для того что бы не выводился первый символ}
sendmessage(form1.handle, wm_mykeyhook, vk_space, application.mainform.handle);
@hook:= nil; // инициализируем переменную hook
hdll:=loadlibrary(pchar('keyboardhook.dll')); { загрузка dll }
if hdll > hinstance_error then
begin { если всё без ошибок, то }
@hook:=getprocaddress(hdll, 'hook'); { получаем указатель на необходимую процедуру}
hook(true, form1.handle);
end
else
begin
showmessage('Ошибка при загрузке dll !');
exit;
end;
end;
procedure destroyhook;
var
hook: procedure (switch : boolean; hmainprog: hwnd) stdcall;
begin
@hook:= nil; // инициализируем переменную hook
if hdll > hinstance_error then
begin { если всё без ошибок, то }
@hook:=getprocaddress(hdll,'hook'); { получаем указатель на необходимую процедуру}
hook(false, form1.handle);
if freelibrary(hdll) then
sleep(1000)
else
exit;
end;
end;
procedure tform1.wndproc(var msg: tmessage);
begin
inherited ; // выполняем всё то, что должно происходить при поступлении сообщеня окну
{Но если пришло наше сообщение - выполняем следующий код}
if msg.msg = wm_mykeyhook then
label1.caption:=label1.caption+chr(msg.wparam);
end;
procedure tform1.formclose(sender: tobject; var action: tcloseaction);
begin
freelibrary(hdll);
end;
procedure tform1.button1click(sender: tobject);
begin
init;
end;
procedure tform1.button2click(sender: tobject);
begin
destroyhook;
end;
initialization
wndflag:=0;
keys:= '';
{ регистрирую своё сообщение в системе - точно так же надо сделать и в теле dll
что бы dll могла посылать главному приложению это сообщение.
}
wm_mykeyhook:=registerwindowmessage('wm_mykeyhook');
end.