Нашел в DRKB тему: "Hook на клавиатуру и мышку".
С библиотекой нет проблем:
| Код |
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 Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
public
procedure WndProc(var Message: TMessage); override;
end;
var
Form1: TForm1;
WndFlag: HWND;
keys: string[41];
hDLL: THandle;
WM_MYKEYHOOK: Cardinal;
implementation
{$R *.dfm}
function GetWndText(WndH: HWND): string;
var
s: string;
Len: integer;
begin
Len:= GetWindowTextLength(WndH)+1;
if Len > 1 then
begin
SetLength(s, Len);
GetWindowText(WndH, @s[1], Len);
Result:= s;
end
else
Result:= 'text not detected';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
SendMessage(Form1.Handle, WM_MYKEYHOOK, VK_SPACE, Application.MainForm.Handle);
@hook:= nil;
hDLL:=LoadLibrary(PChar('keyhook.dll'));
if hDLL > HINSTANCE_ERROR then
begin
@hook:=GetProcAddress(Hdll, 'hook');
Button2.Enabled:=True;
Button1.Enabled:=False;
hook(true, Form1.Handle);
end
else
begin
ShowMessage('Ошибка при загрузке DLL !');
Exit;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;
begin
@hook:= nil;
if hDLL > HINSTANCE_ERROR then
begin
@hook:=GetProcAddress(Hdll, 'hook');
Button1.Enabled:=True;
Button2.Enabled:=False;
hook(false, Form1.Handle);
if FreeLibrary(hDLL) then
begin
sleep(1000)
end
else
begin
Exit;
end;
end;
end;
procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited ;
if Msg.Msg = WM_MYKEYHOOK then
begin
if (WndFlag <> HWND(Msg.lParam)) OR (Length(keys)>=1) then
begin
keys:=keys+String(Chr(Msg.wParam));
memo2.Text:=memo2.Text+' '+inttostr(ord(Chr(Msg.wParam)));
keys:='';
Memo1.Lines.Add(GetWndText(Msg.lParam));
WndFlag:= HWND(Msg.lParam)
end
else
keys:=keys+String(Chr(Msg.wParam));
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
freelibrary(hDLL);
end;
initialization
WndFlag:=0;
keys:= '';
WM_MYKEYHOOK:=RegisterWindowMessage('WM_MYKEYHOOK');
end.
|
Компилятор указывает ошибку:
Declaration 'WndProc' is differs from previous declaration. |
)