I am writing a utility for the API SetWindowsHookEx.
To use it, I would like to have an interface like this:
var
Thread: TKeyboardHookThread;
begin
Thread := TKeyboardHookThread.Create(SomeForm.Handle, SomeMessageNumber);
try
Thread.Resume;
SomeForm.ShowModal;
finally
Thread.Free;
end;
end;
In my current implementation, TKeyboardHookThreadI cannot execute the thread correctly.
The code:
TKeyboardHookThread = class(TThread)
private
class var
FCreated : Boolean;
FKeyReceiverWindowHandle : HWND;
FMessage : Cardinal;
FHiddenWindow : TForm;
public
constructor Create(AKeyReceiverWindowHandle: HWND; AMessage: Cardinal);
destructor Destroy; override;
procedure Execute; override;
end;
function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
S: KBDLLHOOKSTRUCT;
begin
if nCode < 0 then begin
Result := CallNextHookEx(0, nCode, wParam, lParam)
end else begin
S := PKBDLLHOOKSTRUCT(lParam)^;
PostMessage(TKeyboardHookThread.FKeyReceiverWindowHandle, TKeyboardHookThread.FMessage, S.vkCode, 0);
Result := CallNextHookEx(0, nCode, wParam, lParam);
end;
end;
constructor TKeyboardHookThread.Create(AKeyReceiverWindowHandle: HWND;
AMessage: Cardinal);
begin
if TKeyboardHookThread.FCreated then begin
raise Exception.Create('Only one keyboard hook supported');
end;
inherited Create('KeyboardHook', True);
FKeyReceiverWindowHandle := AKeyReceiverWindowHandle;
FMessage := AMessage;
TKeyboardHookThread.FCreated := True;
end;
destructor TKeyboardHookThread.Destroy;
begin
PostMessage(FHiddenWindow.Handle, WM_QUIT, 0, 0);
inherited;
end;
procedure TKeyboardHookThread.Execute;
var
m: tagMSG;
hook: HHOOK;
begin
hook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, 0);
try
FHiddenWindow := TForm.Create(nil);
try
while GetMessage(m, 0, 0, 0) do begin
TranslateMessage(m);
DispatchMessage(m);
end;
finally
FHiddenWindow.Free;
end;
finally
UnhookWindowsHookEx(hook);
end;
end;
AFAICS hook procedure is only called when there is a message loop in the stream. The problem is that I do not know how to get out of this message loop correctly.
I tried to do this using a hidden TFormone that belongs to the stream, but the message loop does not process the messages that I send to the window handle of this form.
How to do this correctly so that the message cycle ends when the stream is turned off?
Edit: The solution I'm using right now looks like this (and works like a charm):
TKeyboardHookThread = class(TThread)
private
class var
FCreated : Boolean;
FKeyReceiverWindowHandle : HWND;
FMessage : Cardinal;
public
constructor Create(AKeyReceiverWindowHandle: HWND; AMessage: Cardinal);
destructor Destroy; override;
procedure Execute; override;
end;
function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
S: KBDLLHOOKSTRUCT;
begin
if nCode < 0 then begin
Result := CallNextHookEx(0, nCode, wParam, lParam)
end else begin
S := PKBDLLHOOKSTRUCT(lParam)^;
PostMessage(TKeyboardHookThread.FKeyReceiverWindowHandle, TKeyboardHookThread.FMessage, S.vkCode, 0);
Result := CallNextHookEx(0, nCode, wParam, lParam);
end;
end;
constructor TKeyboardHookThread.Create(AKeyReceiverWindowHandle: HWND;
AMessage: Cardinal);
begin
if TKeyboardHookThread.FCreated then begin
raise Exception.Create('Only one keyboard hook supported');
end;
inherited Create('KeyboardHook', True);
FKeyReceiverWindowHandle := AKeyReceiverWindowHandle;
FMessage := AMessage;
TKeyboardHookThread.FCreated := True;
end;
destructor TKeyboardHookThread.Destroy;
begin
PostThreadMessage(ThreadId, WM_QUIT, 0, 0);
inherited;
end;
procedure TKeyboardHookThread.Execute;
var
m: tagMSG;
hook: HHOOK;
begin
hook := SetWindowsHookEx(WH_KEYBOARD_LL, @HookProc, HInstance, 0);
try
while GetMessage(m, 0, 0, 0) do begin
TranslateMessage(m);
DispatchMessage(m);
end;
finally
UnhookWindowsHookEx(hook);
end;
end;