Différences
Ci-dessous, les différences entre deux révisions de la page.
| Les deux révisions précédentes Révision précédente Prochaine révision | Révision précédente | ||
|
prog:lazarus:cas:wm_messages:intercepter [10/04/2021 15:01] thierry [Interception dans une Classe] |
prog:lazarus:cas:wm_messages:intercepter [18/03/2023 12:41] (Version actuelle) thierry [Interception d'un Message Windows] |
||
|---|---|---|---|
| Ligne 1: | Ligne 1: | ||
| ====== Interception d'un Message Windows ====== | ====== 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)));'' | ||
| + | <code delphi 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. | ||
| + | </code> | ||
| + | |||
| ===== Interception dans une Classe ===== | ===== Interception dans une Classe ===== | ||
| Ligne 58: | Ligne 98: | ||
| procedure TTICDeviceChangeNotifier.MessageInterceptor(var AMessage: TMessage); | procedure TTICDeviceChangeNotifier.MessageInterceptor(var AMessage: TMessage); | ||
| begin | begin | ||
| + | | ||
| + | // Si le message recu est un WM_DEVICECHANGE alors on l'affiche | ||
| if (AMessage.Msg = WM_DEVICECHANGE) then | if (AMessage.Msg = WM_DEVICECHANGE) then | ||
| DebugLn(TimeToStr(Time) + ' : ' + Format('[%0.4x] - [%0.4x] ', | DebugLn(TimeToStr(Time) + ' : ' + Format('[%0.4x] - [%0.4x] ', | ||
| [AMessage.wParam, AMessage.lParam])); | [AMessage.wParam, AMessage.lParam])); | ||
| + | |||
| + | // DefWindowProc = ??? | ||
| AMessage.Result := DefWindowProc(FHandle, AMessage.Msg, AMessage.wParam, | AMessage.Result := DefWindowProc(FHandle, AMessage.Msg, AMessage.wParam, | ||
| AMessage.lParam); | AMessage.lParam); | ||
| Ligne 68: | Ligne 112: | ||
| end. | end. | ||
| </code> | </code> | ||
| + | ====== 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]] | ||
| + | |||