====== 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)));''
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 :
- 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'')
- Tri et traitement des messages dans la procedure ''MessageInterceptor''
- 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 ======
* [[https://rmdiscala.developpez.com/cours/LesChapitres.html/Cours7/Chap7.2.htm|Tout sur LES MESSAGES WINDOWS]]
* [[https://www.developpez.net/forums/d1446203/autres-langages/pascal/lazarus/interception-messages-windows-service/|Discussion sur l'interception d'un message au sein d'un service]]
* [[https://wiki.lazarus.freepascal.org/Win32/64_Interface#Processing_non-user_messages_in_your_window]]