Home page > Delphi, tips bulk > For MS-Windows > DTMessager: communicate between Windows applications

DTMessager: communicate between Windows applications

Wednesday 31 August 2011, by CapJack

Here is a simple and very effective way to communicate information between two Win32/Win64 applications, running locally on the same workstation. It uses the WM_COPYDATA message transfer. It could also be used to transmit messages from/to an application written in other languages (refer to the Microsoft documentation).

Study the source code of the unit below, or download the complete project. It does not require the installation of the component, the instantiation beeing done dynamically. Five different projects are provided : Delphi 2005, Delphi 2009, Delphi XE2 (VCL), Delphi XE2 (FMX3D) and Lazarus, all able of communicate one with the other. All compiled versions are 32 bits, all needed build files are provided.

Compatibility:
Delphi all non-.NET versions, including XE2 32/64 bits, VCL/FMX.
Lazarus 32/64 bits, from 0.9.25, tested on 0.9.30.

Target platform:
Windows 32/64 bits.

I’m not asking anything in return for this work, except a small link to my site if you find it useful and use it in your software.

Revisions :
September 8 2011 (v3.0): great job of adaptation for Delphi XE2 FMX.
September 6 2011 (v2.0): great job of adaptation for Lazarus. Use of the component is more logical, no more reference now to Application.Mainform. Transmitted messages are in AnsiString format, in order to give the best possible compatibility.

Download the complete project (v3.0)
Windows XP/Vista/7 (32/64 bits)
Version 3.0 - 7806 kiB - Downloads: 369.
License : free, source code included.

Delphi XE2 FMX3D and Delphi 2005 versions communicate together:

The Delphi XE2 VCL version:

  1. (*********************************************************)
  2. (***)                                                 (***)
  3. (***)              UNIT DTMessager;                   (***)
  4. (***)                                                 (***)
  5. (*********************************************************)
  6.  
  7. (*********************************************************)
  8. (* Feel free to use it, but at your own risk!            *)
  9. (* À utiliser librement, mais à vos risques et périls !  *)
  10. (* CapJack - http://capjack.fr                           *)
  11. (*********************************************************)
  12.  
  13.  
  14. (*********************************************************)
  15. (***)                                                 (***)
  16. (***)                  INTERFACE                      (***)
  17. (***)                                                 (***)
  18. (*********************************************************)
  19.  
  20.  
  21. (*********************************************************)
  22. (* TDTMessager (version 3.0)                             *)
  23. (* ----------------------------------------------------- *)
  24. (* Component designed to intercept messages to/from      *)
  25. (* the handle of another application;                    *)
  26. (* it also incorporates an automatic management of       *)
  27. (* WM_COPYDATA event for the exchange of an integer      *)
  28. (* and a string (it's juste an example).                 *)
  29. (* - Enabled: Hook is active or not (true by default)    *)
  30. (* - OnMessage: response to receiving a message.         *)
  31. (*   Precedes OnRecString, the default value of Result   *)
  32. (*   is False, to allow the application perform its      *)
  33. (*   default processing.                                 *)
  34. (* - OnRecString: response to receiving WM_COPYDATA      *)
  35. (*   assumed to contain a string. The other cases should *)
  36. (*   be in WM_COPYDATA OnMessage treated. If OnRecString *)
  37. (*   is assigned, Result is set to TRUE before the call. *)
  38. (* Version 1.1 passes AnsiStrings, in order to get       *)
  39. (* different compilers compatibility.                    *)
  40. (* ----------------------------------------------------- *)
  41. (* Composant conçu pour l'interception de messages       *)
  42. (* vers/depuis le handle d'une autre application ;       *)
  43. (* il incorpore également une gestion automatique de     *)
  44. (* l'évènement WM_COPYDATA pour l'échange d'un entier    *)
  45. (* et d'une chaîne (c'est juste un exemple).             *)
  46. (*  - Enabled : Hook est actif ou pas (true par défaut)  *)
  47. (*  - OnMessage : répond à la réception d'un message.    *)
  48. (*    Précède OnRecString, la valeur par défaut de Result*)
  49. (*    est false, afin de laisser l'application           *)
  50. (*    effectuer son traitement par défaut.               *)
  51. (*  - OnRecString : répond à la réception de WM_COPYDATA *)
  52. (*    supposé contenir une chaîne de caractères. Les     *)
  53. (*    autres cas de figure de WM_COPYDATA doivent être   *)
  54. (*    traités par OnMessage. Si OnRecString est affecté, *)
  55. (*    Result est positionné à TRUE avant l'appel.        *)
  56. (* La version 1.1 passe des AnsiStrings, afin d'obtenir  *)
  57. (* une compatibilité entre les différents compilateurs.  *)
  58. (*********************************************************)
  59.  
  60. uses
  61. {$WARN UNIT_PLATFORM OFF}
  62. {$IFDEF MSWindows}
  63.   {$IFDEF FPC}
  64.     Interfaces,
  65.   {$ENDIF}
  66.   {$IFDEF DCC}
  67.   WinAPI.Windows, System.SysUtils, WinAPI.Messages,
  68.   System.Classes, VCL.Forms, VCL.Dialogs, FMX.Forms;
  69.   {$ELSE}
  70.   Windows, SysUtils, Messages, Classes, Forms, Dialogs;
  71.   {$ENDIF DCC}
  72. {$ELSE}
  73.  'MS-Windows only!'
  74. {$ENDIF MSWindows}
  75.  
  76. type
  77.  
  78. (*********************************************************)
  79. (* TDTOnMessage                                          *)
  80. (* ----------------------------------------------------- *)
  81. (* Type of event OnMessage                               *)
  82. (* ----------------------------------------------------- *)
  83. (* Type de l'évènement OnMessage                         *)
  84. (*********************************************************)
  85.  
  86.   TDTOnMessage = procedure
  87.                         (
  88.                         Msg             : Cardinal;
  89.                         wParam          : Integer;
  90.                         lParam          : Integer;
  91.                         var Handled     : Boolean
  92.                         ) of object;
  93.  
  94. (*********************************************************)
  95. (* TDTOnRecString                                        *)
  96. (* ----------------------------------------------------- *)
  97. (* Type of event OnRecString                             *)
  98. (* ----------------------------------------------------- *)
  99. (* Type de l'évènement OnRecString                       *)
  100. (*********************************************************)
  101.  
  102.   TDTOnRecString = procedure
  103.                         (
  104.                         const SenderWnd : THandle;
  105.                         const Ident     : Integer;
  106.                         const Str       : string;
  107.                         var Handled     : Boolean
  108.                         ) of object;
  109.  
  110. (*********************************************************)
  111. (* TDTMessager                                           *)
  112. (* ----------------------------------------------------- *)
  113. (* Component interface of TDTMessager                    *)
  114. (* ----------------------------------------------------- *)
  115. (* Interface du composant TDTMessager                    *)
  116. (*********************************************************)
  117.  
  118.   TDTMessager = class(TComponent)
  119.   private
  120.     FEnabled     : Boolean;
  121.     FOnMessage   : TDTOnMessage;
  122.     FOnRecString : TDTOnRecString;
  123.  
  124.   protected
  125.     function MessageHook(Code:Integer;wParm:WPARAM;
  126.                          lParm:LPARAM): Boolean;
  127.  
  128.   public
  129.  
  130.     // AOwner MUST be descendent of TCustomForm (VCL)
  131.     // or TCommonCustomForm (FMX)
  132.  
  133.     // AOwner DOIT être descendant de TCustomForm (VCL)
  134.     // ou de TCommonCustomForm (FMX)
  135.  
  136.     constructor Create(AOwner:TComponent);override;
  137.     destructor Destroy;override;
  138.  
  139.   published
  140.  
  141.     property Enabled     : Boolean
  142.                  read    FEnabled
  143.                  write   FEnabled
  144.                  default True;
  145.     property OnMessage   : TDTOnMessage
  146.                  read FOnMessage
  147.                  write FOnMessage;
  148.     property OnRecString : TDTOnRecString
  149.                  read FOnRecString
  150.                  write FOnRecString;
  151.   end;
  152.  
  153. (*********************************************************)
  154. (* DTCopyDataToString                                    *)
  155. (* ----------------------------------------------------- *)
  156. (* Function as the basis for the use of OnRecString      *)
  157. (* between Delphi applications. This function            *)
  158. (* initialize a structure of type TCopyDataStruct        *)
  159. (* (See Windows documentation) with the string           *)
  160. (* and the integer provided.                             *)
  161. (* ----------------------------------------------------- *)
  162. (* Fonction de base pour l'utilisation de OnRecString    *)
  163. (* entre deux applications Delphi. Cette fonction        *)
  164. (* initialise une structure de type TCopyDataStruct      *)
  165. (* (voir documentation Windows) avec la chaîne           *)
  166. (* et l'entier fournis.                                  *)
  167. (*********************************************************)
  168.  
  169. procedure DTCopyDataToString
  170.         (
  171.         const Data      : PCopyDataStruct;
  172.         var Ident       : Integer;
  173.         var Str         : string
  174.         );
  175.  
  176. (*********************************************************)
  177. (* DTCopyDataToString                                    *)
  178. (* ----------------------------------------------------- *)
  179. (* Function as the basis for the use of OnRecString      *)
  180. (* between Delphi applications. This function            *)
  181. (* does the reverse of the previous function             *)
  182. (* by retrieving the string and the integer contained    *)
  183. (* in the Data structure.                                *)
  184. (* ----------------------------------------------------- *)
  185. (* Fonction de base pour l'utilisation de OnRecString    *)
  186. (* entre deux applications Delphi. Cette fonction        *)
  187. (* effectue l'opération inverse de la précédente,        *)
  188. (* en récupérant la chaîne et l'entier contenus          *)
  189. (* dans la structure Data.                               *)
  190. (*********************************************************)
  191.  
  192. procedure DTStringToCopyData
  193.         (
  194.         const Data      : PCopyDataStruct;
  195.         const Ident     : Integer;
  196.         const Str       : string
  197.         );
  198.  
  199. (*********************************************************)
  200. (* DTSendCopyDataString                                  *)
  201. (* ----------------------------------------------------- *)
  202. (* Sends an integer and a string of characters           *)
  203. (* to the given handle in the format described above.    *)
  204. (* Functions as SendMessage.                             *)
  205. (* ----------------------------------------------------- *)
  206. (* Envoie un entier et une chaîne de caractères au       *)
  207. (* handle voulu, sous le format précédemment décrit.     *)
  208. (* Fonctionne comme SendMessage.                         *)
  209. (*********************************************************)
  210.  
  211. function  DTSendCopyDataString
  212.         (
  213.         const Transmitter : HWND;
  214.         const Receiver    : HWND;
  215.         const Ident       : Integer;
  216.         const Str         : string
  217.         ) : LResult;
  218.  
  219. (*********************************************************)
  220. (* DTSendThreadCopyDataString                            *)
  221. (* ----------------------------------------------------- *)
  222. (* Sends an integer and a string to ALL handles of       *)
  223. (* windows associated with the specified thread.         *)
  224. (* ----------------------------------------------------- *)
  225. (* Envoie un entier et une chaîne de caractères à TOUS   *)
  226. (* les handles des fenêtres associées au Thread indiqué. *)
  227. (*********************************************************)
  228.  
  229. function  DTSendThreadCopyDataString
  230.         (
  231.         const Transmitter : HWND;
  232.         const RecThread   : DWORD;
  233.         const Ident       : Integer;
  234.         const Str         : string
  235.         ) : LongBool;
  236.  
  237. procedure Register;
  238.  
  239. (*********************************************************)
  240. (***)                                                 (***)
  241. (***)                IMPLEMENTATION                   (***)
  242. (***)                                                 (***)
  243. (*********************************************************)
  244.  
  245. {$IFDEF DCC}
  246. uses Fmx.Platform.Win;
  247. {$ENDIF}
  248.  
  249. {$R *.res}
  250.  
  251. {---------------------------------------------------------}
  252.  
  253. // Maintains a list of all TDTMessager components created
  254.  
  255. // Maintient une liste de tous les TDTMessager créés.
  256.  
  257. var DTMessagerList : TList;
  258.  
  259. {---------------------------------------------------------}
  260.  
  261. // Transforms a couple integer / string
  262. // in a TCopyDataStruct structure.
  263.  
  264. // Transforme un couple entier/chaîne
  265. // en structure TCopyDataStruct.
  266.  
  267. procedure DTStringToCopyData
  268.         (
  269.         const Data      : PCopyDataStruct;
  270.         const Ident     : Integer;
  271.         const Str       : string
  272.         );
  273.  var lStr:AnsiString;
  274.  begin
  275.   if Data = nil then Exit;
  276.   FillChar(Data^,SizeOf(Data^),0);
  277.   Data^.dwData := Ident;
  278.   if Str = ''
  279.    then begin
  280.          Data^.cbData := 0;
  281.          Data^.lpData := nil;
  282.         end
  283.    else begin
  284.          {$IFDEF FPC}
  285.           lStr := UTF8ToAnsi(Str);
  286.          {$ELSE}
  287.           lStr := AnsiString(Str);
  288.          {$ENDIF}
  289.          Data^.cbData := Length(lStr)*SizeOf(AnsiChar);
  290.          Data^.lpData := PAnsiChar(lStr);
  291.         end
  292.  end;
  293.  
  294. {---------------------------------------------------------}
  295.  
  296. // Performs the inverse transformation of the previous one.
  297.  
  298. // Effectue la transformation inverse de la précédente.
  299.  
  300. procedure DTCopyDataToString
  301.         (
  302.         const Data      : PCopyDataStruct;
  303.         var Ident       : Integer;
  304.         var Str         : string
  305.         );
  306.  var lStr:AnsiString;
  307.  begin
  308.   Ident := 0;
  309.   Str   := '';
  310.   if Data = nil then Exit;
  311.   Ident := Data^.dwData;
  312.   if ( Data^.cbData <> 0 ) and ( Data^.lpData <> nil )
  313.    then SetString(lStr,PAnsiChar(Data^.lpData),
  314.                   Data^.cbData div SizeOf(AnsiChar));
  315.   {$IFDEF FPC}
  316.     Str := AnsiToUTF8(lStr);
  317.   {$ELSE}
  318.     Str := String(lStr);
  319.   {$ENDIF}
  320.  end;
  321.  
  322. {---------------------------------------------------------}
  323.  
  324. // Sends a couple integer/string to a handle,
  325. // via a WM_COPYDATA message.
  326.  
  327. // Envoie un couple entier/chaîne à un handle,
  328. // par le biais d'un message WM_COPYDATA.
  329.  
  330. function  DTSendCopyDataString
  331.         (
  332.         const Transmitter : HWND;
  333.         const Receiver    : HWND;
  334.         const Ident       : Integer;
  335.         const Str         : string
  336.         ) : LResult;
  337.  var Data : TCopyDataStruct;
  338.  begin
  339.   DTStringToCopyData(@Data,Ident,Str);
  340.   Result := SendMessage(Receiver,WM_COPYDATA,
  341.                         wParam(Transmitter),
  342.                         lParam(@Data));
  343.  end;
  344.  
  345. {---------------------------------------------------------}
  346.  
  347. // Loop path of the windows associated with a thread.
  348.  
  349. // Boucle de parcours des fenêtres associées à un thread.
  350.  
  351. function  DTPerformThreadCopyDataString
  352.         (
  353.         const Transmitter : HWND;
  354.         const RecThread   : DWORD;
  355.         const Ident       : Integer;
  356.         const Str         : string;
  357.         const WndProc     : Pointer
  358.         ) : LongBool;
  359.  var Data : TCopyDataStruct;
  360.      Msg  : TMessage;
  361.  begin
  362.   DTStringToCopyData(@Data,Ident,Str);
  363.   Msg.Msg    := WM_COPYDATA;
  364.   Msg.WParam := Transmitter;
  365.   Msg.LParam := Integer(@Data);
  366.   Result := EnumThreadWindows
  367.              (RecThread,
  368.               {$IFDEF FPC}ENUMWINDOWSPROC{$ENDIF}(WndProc),
  369.               Integer(@Msg));
  370.  end;
  371.  
  372. {---------------------------------------------------------}
  373.  
  374. // Function to send the message WM_COPYDATA,
  375. // for use in the previous function.
  376.  
  377. // Fonction d'envoi du message WM_COPYDATA,
  378. // pour usage dans la fonction précédente.
  379.  
  380. function  SendEnumWindowProc (
  381.                                aHwnd : HWND;
  382.                                var Msg:TMessage
  383.                              ): Bool; stdcall;
  384. begin
  385.  SendMessage(aHWnd,Msg.Msg,Msg.wParam,Msg.LParam);
  386.  Result := True;
  387. end;
  388.  
  389. {---------------------------------------------------------}
  390.  
  391. // Send a couple integer/string
  392. // to all the windows of a thread.
  393.  
  394. // Envoie un couple entier/chaîne
  395. // à toutes les fenêtres d'un thread.
  396.  
  397. function  DTSendThreadCopyDataString
  398.         (
  399.         const Transmitter : HWND;
  400.         const RecThread   : DWORD;
  401.         const Ident       : Integer;
  402.         const Str         : string
  403.         ) : LongBool;
  404.  begin
  405.   Result := DTPerformThreadCopyDataString
  406.                            (Transmitter, RecThread,
  407.                             Ident,Str,@SendEnumWindowProc);
  408.  end;
  409.  
  410. {---------------------------------------------------------}
  411.  
  412. // Constructor of the TDTMessager class.
  413.  
  414. // Constructeur de la classe TDTMessager.
  415.  
  416. constructor TDTMessager.Create(AOwner:TComponent);
  417.  begin
  418.   inherited;
  419.   FOnMessage := nil;
  420.   FOnRecString := nil;
  421.   DTMessagerList.Add(Self);
  422.   FEnabled := true;
  423.  end;
  424.  
  425. {---------------------------------------------------------}
  426.  
  427. // Destructor of the TDTMessager class.
  428.  
  429. // Destructeur de la classe TDTMessager.
  430.  
  431. destructor TDTMessager.Destroy;
  432.  var Idx : Integer;
  433.  begin
  434.   FEnabled := false;
  435.   Idx := DTMessagerList.IndexOf(Self);
  436.   if Idx >=0 then DTMessagerList.Delete(Idx);
  437.   inherited;
  438.  end;
  439.  
  440. {---------------------------------------------------------}
  441.  
  442. // TDTMessager Hook method.
  443.  
  444. // Méthode Hook de TDTMessager.
  445.  
  446. function TDTMessager.MessageHook(Code:Integer;wParm:WPARAM;
  447.                                  lParm:LPARAM):Boolean;
  448.  var Wnd : HWnd; Ident : Integer; Str:string;
  449.  begin
  450.   Result := False;
  451.   if not FEnabled then Exit;
  452.   if assigned(FOnMessage)
  453.      then FOnMessage(Code,wParm,lParm,Result);
  454.   if not( Result )
  455.      and ( Code = WM_COPYDATA )
  456.      and assigned( FOnRecString )
  457.    then begin
  458.          Wnd := HWnd( wParm );
  459.          DTCopyDataToString
  460.                    (PCopyDataStruct(lParm),Ident,Str);
  461.          Result := True;
  462.          FOnRecString(Wnd,Ident,Str,Result);
  463.         end;
  464.  end;
  465.  
  466. {---------------------------------------------------------}
  467.  
  468. // Global hook installed by the unit. See:
  469.  
  470. // Hook global installé par l'unité. Voir :
  471.  
  472. // msdn.microsoft.com/en-us/library/ms644975%28v=vs.85%29.aspx
  473.  
  474. function GlobalMessageHook(Code:Integer;wParm:WPARAM;
  475.                            lParm:LPARAM):LRESULT;stdcall;
  476.  var lI : Integer;
  477.      lM : TCWPStruct;
  478.      lC : TDTMessager;
  479.      {$IFDEF DCC}
  480.      lF : VCL.Forms.TCustomForm;
  481.      lX : FMX.Forms.TCommonCustomForm;
  482.      {$ELSE}
  483.      lF : TCustomForm;
  484.      {$ENDIF DCC}
  485.  
  486.  begin
  487.  
  488.   // Dispatch the message to ALL TDTMessager components,
  489.   // placed on the form having the concerned handle.
  490.  
  491.   // Distribue le message à TOUS les composants TDTMessager
  492.   // placés sur la fiche ayant le handle concerné.
  493.  
  494.   if (Code = HC_ACTION) and assigned(DTMessagerList)
  495.    then
  496.     begin
  497.      lM := PCWPStruct(lParm)^;
  498.      for lI := 0 to DTMessagerList.Count - 1
  499.       do begin
  500.           lC := TDTMessager(DTMessagerList[lI]);
  501.           if assigned(lC) then
  502.            begin
  503.  
  504.             {$IFDEF DCC}
  505.  
  506.             // Note my clever trick to determine if our
  507.             // component is on a VCL or FMX form :)
  508.  
  509.             // Notez mon truc astucieux pour déterminer si
  510.             // le composant est sur une fiche VCL ou FMX :)
  511.  
  512.             if (lC.Owner is VCL.Forms.TCustomForm)
  513.              then
  514.               begin
  515.                lF := VCL.Forms.TCustomForm(lC.Owner);
  516.                if lF.HandleAllocated
  517.                and (lF.Handle = lM.hwnd)
  518.                  then lC.MessageHook
  519.                       (lM.message,lM.wParam,lM.lParam);
  520.               end;
  521.  
  522.             if (lC.Owner is FMX.Forms.TCommonCustomForm)
  523.              then
  524.               begin
  525.                lX := FMX.Forms.TCommonCustomForm(lC.Owner);
  526.  
  527.                // *** FmxHandleToHWND ***
  528.  
  529.                // This function retrieve Windows Handle
  530.                // from the FMX internal format handle.
  531.                // Precious for system programmation.
  532.  
  533.                // Cette fonction récupère le handle Windows
  534.                // à partir du handle interne de la FMX.
  535.                // Précieuse pour la programmation système.
  536.  
  537.                if FmxHandleToHWND(lX.Handle) = lM.hwnd
  538.                  then lC.MessageHook
  539.                       (lM.message,lM.wParam,lM.lParam);
  540.               end;
  541.  
  542.             {$ELSE}
  543.  
  544.             if (lC.Owner is TCustomForm)
  545.              then begin
  546.                    lF := TCustomForm(lC.Owner);
  547.                    if lF.HandleAllocated
  548.                    and (lF.Handle = lM.hwnd)
  549.                      then lC.MessageHook
  550.                           (lM.message,lM.wParam,lM.lParam);
  551.                   end;
  552.  
  553.             {$ENDIF DCC}
  554.  
  555.            end;
  556.          end; // for lI ...
  557.     end; // Code = HC_ACTION ...
  558.   Result := CallNextHookEx(0,Code,wParm,lParm);
  559.  end;
  560.  
  561. {---------------------------------------------------------}
  562.  
  563. procedure Register;
  564. begin
  565.   RegisterComponents('Capjack', [TDTMessager]);
  566. end;
  567.  
  568. {---------------------------------------------------------}
  569.  
  570. var GlobalHookHandle : HHook = 0;
  571.  
  572. INITIALIZATION
  573.  try
  574.   DTMessagerList   := TList.Create;
  575.  
  576.   GlobalHookHandle := SetWindowsHookEx
  577.           (WH_CALLWNDPROC,
  578.            {$IFDEF FPC}HOOKPROC{$ENDIF}(@GlobalMessageHook),
  579.            0, GetCurrentThreadId);
  580.  finally
  581.  end;
  582.  
  583. FINALIZATION
  584.  try
  585.   UnhookWindowsHookEx(GlobalHookHandle);
  586.   if assigned(DTMessagerList) then DTMessagerList.Free;
  587.  finally
  588.  end;
  589.  
  590. END.