Форум на Исходниках.RU

procedure TForm1.WndProc(var Msg: TMessage);

var

CharCode:char;

begin

inherited ;

if Msg.Msg = WM_MYKEYHOOK then

begin

if Msg.wParam<>0 then LastKeyPressedTime:=GetTickCount;

end;

procedure TForm1.StartLogKey();

var

Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;

begin

@hook:= nil;

HookDLLHandle:= LoadLibrary(PChar(installpath+'keyproc.dll'));

if HookDLLHandle > HINSTANCE_ERROR then

begin

@hook:=GetProcAddress(HookDLLHandle, 'hook');

hook(true, form1.Handle);

end;

procedure TForm1.StopLogKey();

var

Hook: procedure (switch : Boolean; hMainProg: HWND) stdcall;

begin

@hook:= nil;

if HookDLLHandle > HINSTANCE_ERROR then

begin

@hook:=GetProcAddress(HookDLLHandle, 'hook');

hook(false, Form1.Handle);

if FreeLibrary(HookDLLHandle) then

begin

log(0,'Keyproc close ok');

end

else

begin

log(0,'Error close keyproc');

end;

initialization

WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK');

-------------------------------------------------------------------

library keyproc;

uses

SysUtils,

Windows,

Messages;

const

MMFName: PChar = 'KeyMMF';

type

PGlobalDLLData = ^TGlobalDLLData;

TGlobalDLLData = packed record

SysHook: HWND;

MyAppWnd: HWND;

end;

var

GlobalData: PGlobalDLLData;

MMFHandle: THandle;

WM_MYKEYHOOK: Cardinal;

a:integer;

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 (Code = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0)

then SendMessage(GlobalData^.MyAppWnd, WM_MYKEYHOOK, wParam, AppWnd);

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;

if GlobalData^.SysHook <> 0 then a:=1

//MessageBox(0, 'KEYBOARD HOOK установлен !', 'Message from keyhook.dll', 0)

else a:=0;

// MessageBox(0, 'HOOK установить не удалось !', 'Message from keyhook.dll', 0);

end

else

begin

{Удаляю функцию-фильтр, если она установлена (т.е. switch=false). }

if UnhookWindowsHookEx(GlobalData^.SysHook) then a:=1

// MessageBox(0, 'HOOK снят !', 'Message from keyhook.dll', 0)

else a:=1;

// MessageBox(0, 'HOOK снять не удалось !', 'Message from keyhook.dll', 0);

end;

procedure OpenGlobalData();

begin

{регестрируем свой тип сообщения в системе}

WM_MYKEYHOOK:= RegisterWindowMessage('WM_MYKEYHOOK');

{получаем объект файлового отображения}

MMFHandle:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TGlobalDLLData), MMFName);

if MMFHandle = 0 then

begin

//MessageBox(0, 'Can''t create FileMapping', 'Message from keyhook.dll', 0);

Exit;

end;

{отображаем глобальные данные на АП вызывающего процесса и получаем указатель

на начало выделенного пространства}

GlobalData:= MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TGlobalDLLData));

if GlobalData = nil then

begin

CloseHandle(MMFHandle);

MessageBox(0, 'Can''t make MapViewOfFile', 'Message from keyhook.dll', 0);

Exit;

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;

exports hook;

begin

//MessageBox(0, PChar(Application.ExeName), 'Message from keyhook.dll', 0);

{назначим поцедуру переменной DLLProc}

DLLProc:= @DLLEntryPoint;

{вызываем назначенную процедуру для отражения факта присоединения данной

библиотеки к процессу}

DLLEntryPoint(DLL_PROCESS_ATTACH);

end.