123 lines
3.1 KiB
ObjectPascal
123 lines
3.1 KiB
ObjectPascal
{*******************************************************}
|
|
{ MiTeC WinEventHook }
|
|
{ }
|
|
{ Copyright (c) 2020-2020 Michal Mutl }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
{$INCLUDE Compilers.Inc}
|
|
|
|
unit MiTeC_WinEventHook;
|
|
|
|
interface
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
WinAPI.Windows, System.SysUtils, System.Classes;
|
|
{$ELSE}
|
|
Windows, SysUtils, Classes;
|
|
{$ENDIF}
|
|
|
|
type
|
|
TWinEvent = record
|
|
Hook: THandle;
|
|
Event: Cardinal;
|
|
hWnd: THandle;
|
|
idObject: Longint;
|
|
idChild: Longint;
|
|
idEventThread: Cardinal;
|
|
dwmsEventTime: Cardinal;
|
|
EventTime: TDateTime;
|
|
end;
|
|
|
|
TWinEventHook = class;
|
|
|
|
TWinEventHookNotify = procedure(Hook: TWinEventHook; const Data: TWinEvent) of object;
|
|
|
|
TWinEventHook = class
|
|
private
|
|
FHook: hHook;
|
|
FOnExecute: TWinEventHookNotify;
|
|
FActive: Boolean;
|
|
FEventMin: Cardinal;
|
|
FEventMax: Cardinal;
|
|
FContext: Cardinal;
|
|
procedure SetActive(const Value: Boolean);
|
|
public
|
|
constructor Create(AEventMin: Cardinal; AEventMax: Cardinal = 0; AContext: Cardinal = WINEVENT_OUTOFCONTEXT); reintroduce;
|
|
destructor Destroy; override;
|
|
property Active: Boolean read FActive write SetActive;
|
|
property OnExecute: TWinEventHookNotify read FOnExecute write FOnExecute;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF RAD9PLUS}
|
|
System.DateUtils;
|
|
{$ELSE}
|
|
DateUtils;
|
|
{$ENDIF}
|
|
|
|
var
|
|
_WinEventHook: TWinEventHook = nil;
|
|
|
|
{ TWinEventHook }
|
|
|
|
procedure WinEventProcCallBack(HWINEVENTHOOK: THandle; Event: Cardinal; hWnd: hwnd; idObject, idChild: Longint; idEventThread, dwmsEventTime: Cardinal); stdcall;
|
|
var
|
|
r: TWinEvent;
|
|
begin
|
|
r.Hook:=HWINEVENTHOOK;
|
|
r.Event:=Event;
|
|
r.hWnd:=hWnd;
|
|
r.idObject:=idObject;
|
|
r.idChild:=idChild;
|
|
r.idEventThread:=idEventThread;
|
|
r.dwmsEventTime:=dwmsEventTime;
|
|
r.EventTime:=IncMilliSecond(Now,dwmsEventTime-GetTickCount);
|
|
if Assigned(_WinEventHook) and Assigned(_WinEventHook.OnExecute) then
|
|
_WinEventHook.OnExecute(_WinEventHook,r);
|
|
end;
|
|
|
|
destructor TWinEventHook.Destroy;
|
|
begin
|
|
Active:=False;
|
|
_WinEventHook:=nil;
|
|
inherited;
|
|
end;
|
|
|
|
constructor TWinEventHook.Create(AEventMin: Cardinal; AEventMax: Cardinal = 0; AContext: Cardinal = WINEVENT_OUTOFCONTEXT);
|
|
begin
|
|
inherited Create;
|
|
if Assigned(_WinEventHook) then
|
|
raise Exception.Create(ClassName+' already instantiated.');
|
|
FOnExecute:=nil;
|
|
FHook:=0;
|
|
FActive:=False;
|
|
FEventMin:=AEventMin;
|
|
if AEventMax=0 then
|
|
AEventMax:=AEventMin;
|
|
FEventMax:=AEventMax;
|
|
FContext:=AContext;
|
|
_WinEventHook:=Self;
|
|
end;
|
|
|
|
procedure TWinEventHook.SetActive(const Value: Boolean);
|
|
begin
|
|
if FActive=Value then
|
|
Exit;
|
|
FActive:=Value;
|
|
if FActive then begin
|
|
FHook:=SetWinEventHook(FEventMin,FEventMax,0,WinEventProcCallBack,0,0,FContext);
|
|
if (FHook=0) then begin
|
|
FActive:=False;
|
|
raise Exception.Create(ClassName+' activation failed.');
|
|
end;
|
|
end else begin
|
|
if (FHook<>0) then
|
|
UnhookWinEvent(FHook);
|
|
FHook:=0;
|
|
end;
|
|
end;
|
|
|
|
end.
|