Table des matières

Interception d'un Message Windows

Intercepter les WMMessages d'un TForm

On detourne WNDProc avec la function Windows.WNDPROC(SetWindowLongPtr(AFormHandle, GWL_WNDPROC, PtrUInt(@NewWndCallback)));

uWMInterceptor.pas
unit uWMInterceptor;
 
{$mode ObjFPC}{$H+}
interface
 
uses
  SysUtils,  Forms,  Controls,  Windows, LazLogger;
var
  OldWndProc: WNDPROC;
 
procedure InitWMInterception(AFormHandle: THandle);
 
implementation
 
function NewWndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
  lParam: LParam): LRESULT; stdcall;
begin
   { Traitement des messages intercéptés }
  case uMsg of
    WM_DEVICECHANGE: debugLn('Message : %x, %x, %x', [uMsg, wParam, lParam]);
  end;
 
  { Appel de l'ancienne WNDProc }
  Result := Windows.CallWindowProc(OldWndProc, Ahwnd, uMsg, WParam, LParam);
end;
 
procedure InitWMInterception(AFormHandle: THandle);
begin
  if AFormHandle <> 0 then
 
     { Defini NewWndCallback comme nouvel intercepteur et stock l'ancien dans OldWinProc }
    OldWndProc := Windows.WNDPROC(SetWindowLongPtr(AFormHandle, GWL_WNDPROC, PtrUInt(@NewWndCallback)));
end;
 
end.

Interception dans une Classe

Ci dessous on cherche a intercepter le Message Windows WM_DEVICECHANGE dans une class.

Trois étapes :

  1. Dans le Create de notre class, détournement de tous les messages vers la procedure MessageInterceptor
    grâce à lclintf.AllocateHWnd(@MessageInterceptor);
    (ATTENTION AllocateHWnd seul ne fonctionne pas, il faut bien préciser LCLIntf.AllocateHWnd)
  2. Tri et traitement des messages dans la procedure MessageInterceptor
  3. Retransmission du message a la fin de la procedure MessageInterceptor avec AMessage.Result := DefWindowProc(FHandle, AMessage.Msg, AMessage.wParam, AMessage.lParam);
unit uTICDeviceChangeNotifier;
 
{$mode objfpc}{$H+}
 
interface
 
uses
   Classes,
   forms,
   LazLogger,
   LCLIntf, 
   SysUtils,
   windows;
 
type
 
   { TTICDeviceChangeNotifier }
 
   TTICDeviceChangeNotifier = class(TObject)
   private
      FHandle: HWND;
      procedure MessageInterceptor(var AMessage: TMessage);
   protected
   public
      constructor Create; //override;
      destructor Destroy; override;
   published
   end;
 
implementation
 
{ TTICDeviceChangeNotifier }
 
constructor TTICDeviceChangeNotifier.Create;
begin
   inherited Create;
   { AllocateHWnd créé une fenêtre Windows invisible servant a recevoir les Messages Windows }
   { FHandle = le Handle de la fenêtre cree, sinon 0 }
   FHandle := lclintf.AllocateHWnd(@MessageInterceptor);
end;
 
destructor TTICDeviceChangeNotifier.Destroy;
begin
   lclintf.DeallocateHWnd(FHandle);
   inherited Destroy;
end;
 
procedure TTICDeviceChangeNotifier.MessageInterceptor(var AMessage: TMessage);
begin
 
  // Si le message recu est un WM_DEVICECHANGE alors on l'affiche
   if (AMessage.Msg = WM_DEVICECHANGE) then
      DebugLn(TimeToStr(Time) + ' : ' + Format('[%0.4x] - [%0.4x] ',
         [AMessage.wParam, AMessage.lParam]));
 
  // DefWindowProc = ???
   AMessage.Result := DefWindowProc(FHandle, AMessage.Msg, AMessage.wParam,
      AMessage.lParam);
end;
 
 
end.

Sources & Ressources