WinEventHook

unit WinEventHook;

interface

uses
  Windows, Generics.Collections;

TYPE
  TWinEventHookHandle = THandle;

  TWinEventStruct = record
    Hook: TWinEventHookHandle;
    Event: DWORD;
    hWnd: THandle;
    idObject: Longint;
    idChild: Longint;
    idEventThread: DWORD;
    dwmsEventTime: DWORD;
    EventTime: TDateTime;
    EventClass: String;
  end;
{$M+}

Type
  TWinEventHook = class;
  TWinEventHookNotify = reference to procedure(Hook: TWinEventHook; const HookMsg: TWinEventStruct);
  TWinEventHookProcs = TDictionary<TWinEventHookHandle, TWinEventHook>;

  TWinEventHook = class
  private
    class var FWinEventHookProcs: TWinEventHookProcs;
  private
    FHook: hHook;
    FOnExecute: TWinEventHookNotify;
    FActive: Boolean;
    FEventMin: DWORD;
    FEventMax: DWORD;
    FContext: DWORD;
    procedure SetActive(const Value: Boolean);
  published
    property Active: Boolean read FActive write SetActive;
  public
    constructor Create(eventMin: DWORD; eventMax: DWORD = 0; aContext: DWORD = WINEVENT_OUTOFCONTEXT); reintroduce;
    destructor Destroy; override;
    class constructor Create;
    class Destructor Destroy;
    property OnExecute: TWinEventHookNotify read FOnExecute write FOnExecute;
  end;

implementation

uses
  System.SysUtils, System.DateUtils;

{ TWinEventHook }

procedure WinEventProcCallBack(HWINEVENTHOOK: THandle; Event: DWORD; hWnd: hWnd; idObject, idChild: Longint; idEventThread, dwmsEventTime: DWORD); stdcall;
var
  WinEventHook: TWinEventHook;
  WinEventStruct: TWinEventStruct;
  ClassName: String;
begin
  if not TWinEventHook.FWinEventHookProcs.TryGetValue(HWINEVENTHOOK, WinEventHook) then
    exit;

  if not WinEventHook.Active then
    exit;

  WinEventStruct.Hook := HWINEVENTHOOK;
  WinEventStruct.Event := Event;
  WinEventStruct.hWnd := hWnd;
  WinEventStruct.idObject := idObject;
  WinEventStruct.idChild := idChild;
  WinEventStruct.idEventThread := idEventThread;
  WinEventStruct.dwmsEventTime := dwmsEventTime;

  WinEventStruct.EventTime := IncMilliSecond(Now, dwmsEventTime - GetTickCount);

  SetLength(ClassName, 255);
  SetLength(ClassName, GetClassName(hWnd, pChar(ClassName), 255));
  WinEventStruct.EventClass := ClassName;

  WinEventHook.FOnExecute(WinEventHook, WinEventStruct);
end;

destructor TWinEventHook.Destroy;
begin
  Active := False;
  inherited;
end;

constructor TWinEventHook.Create(eventMin: DWORD; eventMax: DWORD = 0; aContext: DWORD = WINEVENT_OUTOFCONTEXT);
begin
  inherited Create;
  FHook := 0;
  FActive := False;
  FEventMin := eventMin;
  if eventMax = 0 then
    eventMax := eventMin;

  FEventMax := eventMax;
  FContext := aContext;
end;

class destructor TWinEventHook.Destroy;
begin
  FWinEventHookProcs.Free;
end;

procedure TWinEventHook.SetActive(const Value: Boolean);
begin
  if FActive = Value then
    exit;

  FActive := Value;

  case FActive of
    True:
      begin
        FHook := SetWinEventHook(FEventMin, FEventMax, 0, WinEventProcCallBack, 0, 0, FContext);
        if (FHook = 0) then
        begin
          FActive := False;
          raise Exception.Create(ClassName + ' CREATION FAILED!');
        end;
        FWinEventHookProcs.Add(FHook, Self);
      end;

    False:
      begin
        if (FHook <> 0) then
        begin
          UnhookWinEvent(FHook);
          FWinEventHookProcs.Remove(FHook);
        end;
        FHook := 0;
      end;
  end;
end;

class constructor TWinEventHook.Create;
begin
  FWinEventHookProcs := TDictionary<TWinEventHookHandle, TWinEventHook>.Create();
end;

end.

**** EXAMPLE OF USE ***

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, WinEventHook;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FStartDragHook: TWinEventHook;
    FEndDragHook: TWinEventHook;
    procedure HookProc(Hook: TWinEventHook; const HookMsg: TWinEventStruct);
  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  DateUtils;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FStartDragHook := TWinEventHook.Create(EVENT_OBJECT_CREATE);

  with FStartDragHook do
  begin
    OnExecute := HookProc;
    Active := True;
  end;

  FEndDragHook := TWinEventHook.Create(EVENT_OBJECT_DESTROY);

  with FEndDragHook do
  begin
    OnExecute := HookProc;
    Active := True;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FStartDragHook.Free;;
  FEndDragHook.Free;
end;

procedure TForm1.HookProc(Hook: TWinEventHook; const HookMsg: TWinEventStruct);
begin
  if pChar(HookMsg.EventClass) = 'SysDragImage' then
  begin
    if HookMsg.Event = EVENT_OBJECT_CREATE then
      Memo1.Lines.Add(TimeToStr(HookMsg.EventTime) + ': Drag Start')
    else
      Memo1.Lines.Add(TimeToStr(HookMsg.EventTime) + ': Drag End');
  end;
end;

end.