====== 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]]