Console App and SetWindowsHookEx - delphi

Question

Trying to setup a SetWindowsHookEx(WH_KEYBOARD) from a console app. I'm doing this inside thread, because I tried to to use the TThread.WaitFor method to keep the application openned, while the thread is running.
Important code parts:
type
THookKeyboard = procedure; stdcall;
KeyloggerThread = class(TThread)
private
const
MESSAGE_CODE = WM_USER + $1000;
var
HookOn, HookOff: THookKeyboard;
MsgReceptor: ^Integer;
MemFile: THandle;
function InstallKeyLogger(const TempDir: String): bool;
procedure HookMessage(var MessageHandler: TMessage); message MESSAGE_CODE;
protected
constructor Create;
procedure Execute; override;
end;
var
KeylogThreadCtrl: KeyloggerThread;
function KeyloggerThread.InstallKeyLogger(const TempDir: String): bool;
var
DLLHandle: THandle;
begin
Result:= false;
if FileExists(TempDir + DLLName) = true then
begin
DLLHandle:= LoadLibrary(PChar(TempDir + DLLName));
if DLLHandle <> 0 then
begin
#HookOn:= GetProcAddress(DLLHandle, 'HookOn');
#HookOff:= GetProcAddress(DLLHandle, 'HookOff');
end;
if assigned(HookOn) and assigned(HookOff) then
begin
MemFile:= CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,SizeOf(Integer), 'Win32KLCom');
if MemFile <> 0 then
begin
MessageBox(0, 'starting keylogger', 'hook', MB_OK);
MsgReceptor:= MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
HookOn;
Result:= true;
end;
end;
end;
end;
procedure KeyloggerThread.HookMessage(var MessageHandler: TMessage);
begin
MessageBox(0, 'pressed something!', 'hook', MB_OK);
end;
constructor KeyloggerThread.Create;
begin
inherited Create(false);
end;
procedure KeyloggerThread.Execute;
begin
while not Terminated do
begin
if not assigned(HookOn) then
if InstallKeyLogger(ExtractFilePath(ParamStr(0))) = false then
Terminate;
end;
end;
begin
if ParamStr(1) = '-runkeylog' then
begin
MessageBox(0, 'going to install keylogger', 'hook', MB_OK);
KeylogThreadCtrl:= KeyloggerThread.Create;
KeylogThreadCtrl.WaitFor;
end
end;
I know the InstallKeyLogger function is going fine, because I get the messagebox 'starting keylogger'.
Once I press any key, windows start freezing and I need to finish the application. The DLL code is:
library KeyboardDLL;
uses
Windows,
Messages;
{$R *.res}
const
MESSAGE_CODE = WM_USER + $1000;
var
KeyboardHook: HHook;
MemFile: THandle;
MsgReceptor: ^Integer;
function HookCallBack( Code : Integer;
wParam : WPARAM;
lParam : LPARAM
) : LRESULT; stdcall;
begin
if code=HC_ACTION then
begin
MemFile:= OpenFileMapping(FILE_MAP_WRITE,False, 'Win32KLCom');
if MemFile<>0 then
begin
MsgReceptor:= MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
PostMessage(MsgReceptor^,MESSAGE_CODE,wParam,lParam);
end;
end;
Result:= CallNextHookEx(KeyboardHook, Code, wParam, lParam)
end;
procedure HookOn; stdcall;
begin
KeyboardHook:= SetWindowsHookEx(WH_KEYBOARD, #HookCallBack, HInstance , 0);
end;
procedure HookOff; stdcall;
begin
UnmapViewOfFile(MsgReceptor);
CloseHandle(MemFile);
UnhookWindowsHookEx(KeyboardHook);
end;
exports
HookOn,
HookOff;
begin
end.

Answer 1

It looks like you ported your hosting code from a VCL application, because you have some assumptions that don't hold for stand-alone threads, like the one you have there:
procedure HookMessage(var MessageHandler: TMessage); message MESSAGE_CODE;
Message procedures like this one only work in the context of a VCL form or control.
You can only post messages (use PostMessage) to window handles, not memory mapped files (as you attempt with the MsgReceptor pointer).
If you want your thread to be able to process messages, you must create a window handle and the thread must have a message loop (GetMessage/DispatchMessage, or similar).