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: 1092.
License : free, source code included.
Delphi XE2 FMX3D and Delphi 2005 versions communicate together:
The Delphi XE2 VCL version:
Download the source code below
(*********************************************************)
(***)                                                 (***)
(***)              UNIT DTMessager;                   (***)
(***)                                                 (***)
(*********************************************************)
 
(*********************************************************)
(* Feel free to use it, but at your own risk!            *)
(* À utiliser librement, mais à vos risques et périls !  *)
(* CapJack - http://capjack.fr                           *)
(*********************************************************)
 
 
(*********************************************************)
(***)                                                 (***)
(***)                  INTERFACE                      (***)
(***)                                                 (***)
(*********************************************************)
 
 
(*********************************************************)
(* TDTMessager (version 3.0)                             *)
(* ----------------------------------------------------- *)
(* Component designed to intercept messages to/from      *)
(* the handle of another application;                    *)
(* it also incorporates an automatic management of       *)
(* WM_COPYDATA event for the exchange of an integer      *)
(* and a string (it's juste an example).                 *)
(* - Enabled: Hook is active or not (true by default)    *)
(* - OnMessage: response to receiving a message.         *)
(*   Precedes OnRecString, the default value of Result   *)
(*   is False, to allow the application perform its      *)
(*   default processing.                                 *)
(* - OnRecString: response to receiving WM_COPYDATA      *)
(*   assumed to contain a string. The other cases should *)
(*   be in WM_COPYDATA OnMessage treated. If OnRecString *)
(*   is assigned, Result is set to TRUE before the call. *)
(* Version 1.1 passes AnsiStrings, in order to get       *)
(* different compilers compatibility.                    *)
(* ----------------------------------------------------- *)
(* Composant conçu pour l'interception de messages       *)
(* vers/depuis le handle d'une autre application ;       *)
(* il incorpore également une gestion automatique de     *)
(* l'évènement WM_COPYDATA pour l'échange d'un entier    *)
(* et d'une chaîne (c'est juste un exemple).             *)
(*  - Enabled : Hook est actif ou pas (true par défaut)  *)
(*  - OnMessage : répond à la réception d'un message.    *)
(*    Précède OnRecString, la valeur par défaut de Result*)
(*    est false, afin de laisser l'application           *)
(*    effectuer son traitement par défaut.               *)
(*  - OnRecString : répond à la réception de WM_COPYDATA *)
(*    supposé contenir une chaîne de caractères. Les     *)
(*    autres cas de figure de WM_COPYDATA doivent être   *)
(*    traités par OnMessage. Si OnRecString est affecté, *)
(*    Result est positionné à TRUE avant l'appel.        *)
(* La version 1.1 passe des AnsiStrings, afin d'obtenir  *)
(* une compatibilité entre les différents compilateurs.  *)
(*********************************************************)
 
uses
{$WARN UNIT_PLATFORM OFF}
{$IFDEF MSWindows}
  {$IFDEF FPC}
    Interfaces,
  {$ENDIF}
  {$IFDEF DCC}
  WinAPI.Windows, System.SysUtils, WinAPI.Messages,
  System.Classes, VCL.Forms, VCL.Dialogs, FMX.Forms;
  {$ELSE}
  Windows, SysUtils, Messages, Classes, Forms, Dialogs;
  {$ENDIF DCC}
{$ELSE}
 'MS-Windows only!'
{$ENDIF MSWindows}
 
type
 
(*********************************************************)
(* TDTOnMessage                                          *)
(* ----------------------------------------------------- *)
(* Type of event OnMessage                               *)
(* ----------------------------------------------------- *)
(* Type de l'évènement OnMessage                         *)
(*********************************************************)
 
  TDTOnMessage = procedure
                        (
                        Msg             : Cardinal;
                        wParam          : Integer;
                        lParam          : Integer;
                        var Handled     : Boolean
                        ) of object;
 
(*********************************************************)
(* TDTOnRecString                                        *)
(* ----------------------------------------------------- *)
(* Type of event OnRecString                             *)
(* ----------------------------------------------------- *)
(* Type de l'évènement OnRecString                       *)
(*********************************************************)
 
  TDTOnRecString = procedure
                        (
                        const SenderWnd : THandle;
                        const Ident     : Integer;
                        const Str       : string;
                        var Handled     : Boolean
                        ) of object;
 
(*********************************************************)
(* TDTMessager                                           *)
(* ----------------------------------------------------- *)
(* Component interface of TDTMessager                    *)
(* ----------------------------------------------------- *)
(* Interface du composant TDTMessager                    *)
(*********************************************************)
 
  TDTMessager = class(TComponent)
  private
    FEnabled     : Boolean;
    FOnMessage   : TDTOnMessage;
    FOnRecString : TDTOnRecString;
 
  protected
    function MessageHook(Code:Integer;wParm:WPARAM;
                         lParm:LPARAM): Boolean;
 
  public
 
    // AOwner MUST be descendent of TCustomForm (VCL)
    // or TCommonCustomForm (FMX)
 
    // AOwner DOIT être descendant de TCustomForm (VCL)
    // ou de TCommonCustomForm (FMX)
 
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
 
  published
 
    property Enabled     : Boolean
                 read    FEnabled
                 write   FEnabled
                 default True;
    property OnMessage   : TDTOnMessage
                 read FOnMessage
                 write FOnMessage;
    property OnRecString : TDTOnRecString
                 read FOnRecString
                 write FOnRecString;
  end;
 
(*********************************************************)
(* DTCopyDataToString                                    *)
(* ----------------------------------------------------- *)
(* Function as the basis for the use of OnRecString      *)
(* between Delphi applications. This function            *)
(* initialize a structure of type TCopyDataStruct        *)
(* (See Windows documentation) with the string           *)
(* and the integer provided.                             *)
(* ----------------------------------------------------- *)
(* Fonction de base pour l'utilisation de OnRecString    *)
(* entre deux applications Delphi. Cette fonction        *)
(* initialise une structure de type TCopyDataStruct      *)
(* (voir documentation Windows) avec la chaîne           *)
(* et l'entier fournis.                                  *)
(*********************************************************)
 
procedure DTCopyDataToString
        (
        const Data      : PCopyDataStruct;
        var Ident       : Integer;
        var Str         : string
        );
 
(*********************************************************)
(* DTCopyDataToString                                    *)
(* ----------------------------------------------------- *)
(* Function as the basis for the use of OnRecString      *)
(* between Delphi applications. This function            *)
(* does the reverse of the previous function             *)
(* by retrieving the string and the integer contained    *)
(* in the Data structure.                                *)
(* ----------------------------------------------------- *)
(* Fonction de base pour l'utilisation de OnRecString    *)
(* entre deux applications Delphi. Cette fonction        *)
(* effectue l'opération inverse de la précédente,        *)
(* en récupérant la chaîne et l'entier contenus          *)
(* dans la structure Data.                               *)
(*********************************************************)
 
procedure DTStringToCopyData
        (
        const Data      : PCopyDataStruct;
        const Ident     : Integer;
        const Str       : string
        );
 
(*********************************************************)
(* DTSendCopyDataString                                  *)
(* ----------------------------------------------------- *)
(* Sends an integer and a string of characters           *)
(* to the given handle in the format described above.    *)
(* Functions as SendMessage.                             *)
(* ----------------------------------------------------- *)
(* Envoie un entier et une chaîne de caractères au       *)
(* handle voulu, sous le format précédemment décrit.     *)
(* Fonctionne comme SendMessage.                         *)
(*********************************************************)
 
function  DTSendCopyDataString
        (
        const Transmitter : HWND;
        const Receiver    : HWND;
        const Ident       : Integer;
        const Str         : string
        ) : LResult;
 
(*********************************************************)
(* DTSendThreadCopyDataString                            *)
(* ----------------------------------------------------- *)
(* Sends an integer and a string to ALL handles of       *)
(* windows associated with the specified thread.         *)
(* ----------------------------------------------------- *)
(* Envoie un entier et une chaîne de caractères à TOUS   *)
(* les handles des fenêtres associées au Thread indiqué. *)
(*********************************************************)
 
function  DTSendThreadCopyDataString
        (
        const Transmitter : HWND;
        const RecThread   : DWORD;
        const Ident       : Integer;
        const Str         : string
        ) : LongBool;
 
procedure Register;
 
(*********************************************************)
(***)                                                 (***)
(***)                IMPLEMENTATION                   (***)
(***)                                                 (***)
(*********************************************************)
 
{$IFDEF DCC}
uses Fmx.Platform.Win;
{$ENDIF}
 
{$R *.res}
 
{---------------------------------------------------------}
 
// Maintains a list of all TDTMessager components created
 
// Maintient une liste de tous les TDTMessager créés.
 
var DTMessagerList : TList;
 
{---------------------------------------------------------}
 
// Transforms a couple integer / string
// in a TCopyDataStruct structure.
 
// Transforme un couple entier/chaîne
// en structure TCopyDataStruct.
 
procedure DTStringToCopyData
        (
        const Data      : PCopyDataStruct;
        const Ident     : Integer;
        const Str       : string
        );
 var lStr:AnsiString;
 begin
  if Data = nil then Exit;
  FillChar(Data^,SizeOf(Data^),0);
  Data^.dwData := Ident;
  if Str = ''
   then begin
         Data^.cbData := 0;
         Data^.lpData := nil;
        end
   else begin
         {$IFDEF FPC}
          lStr := UTF8ToAnsi(Str);
         {$ELSE}
          lStr := AnsiString(Str);
         {$ENDIF}
         Data^.cbData := Length(lStr)*SizeOf(AnsiChar);
         Data^.lpData := PAnsiChar(lStr);
        end
 end;
 
{---------------------------------------------------------}
 
// Performs the inverse transformation of the previous one.
 
// Effectue la transformation inverse de la précédente.
 
procedure DTCopyDataToString
        (
        const Data      : PCopyDataStruct;
        var Ident       : Integer;
        var Str         : string
        );
 var lStr:AnsiString;
 begin
  Ident := 0;
  Str   := '';
  if Data = nil then Exit;
  Ident := Data^.dwData;
  if ( Data^.cbData <> 0 ) and ( Data^.lpData <> nil )
   then SetString(lStr,PAnsiChar(Data^.lpData),
                  Data^.cbData div SizeOf(AnsiChar));
  {$IFDEF FPC}
    Str := AnsiToUTF8(lStr);
  {$ELSE}
    Str := String(lStr);
  {$ENDIF}
 end;
 
{---------------------------------------------------------}
 
// Sends a couple integer/string to a handle,
// via a WM_COPYDATA message.
 
// Envoie un couple entier/chaîne à un handle,
// par le biais d'un message WM_COPYDATA.
 
function  DTSendCopyDataString
        (
        const Transmitter : HWND;
        const Receiver    : HWND;
        const Ident       : Integer;
        const Str         : string
        ) : LResult;
 var Data : TCopyDataStruct;
 begin
  DTStringToCopyData(@Data,Ident,Str);
  Result := SendMessage(Receiver,WM_COPYDATA,
                        wParam(Transmitter),
                        lParam(@Data));
 end;
 
{---------------------------------------------------------}
 
// Loop path of the windows associated with a thread.
 
// Boucle de parcours des fenêtres associées à un thread.
 
function  DTPerformThreadCopyDataString
        (
        const Transmitter : HWND;
        const RecThread   : DWORD;
        const Ident       : Integer;
        const Str         : string;
        const WndProc     : Pointer
        ) : LongBool;
 var Data : TCopyDataStruct;
     Msg  : TMessage;
 begin
  DTStringToCopyData(@Data,Ident,Str);
  Msg.Msg    := WM_COPYDATA;
  Msg.WParam := Transmitter;
  Msg.LParam := Integer(@Data);
  Result := EnumThreadWindows
             (RecThread,
              {$IFDEF FPC}ENUMWINDOWSPROC{$ENDIF}(WndProc),
              Integer(@Msg));
 end;
 
{---------------------------------------------------------}
 
// Function to send the message WM_COPYDATA,
// for use in the previous function.
 
// Fonction d'envoi du message WM_COPYDATA,
// pour usage dans la fonction précédente.
 
function  SendEnumWindowProc (
                               aHwnd : HWND;
                               var Msg:TMessage
                             ): Bool; stdcall;
begin
 SendMessage(aHWnd,Msg.Msg,Msg.wParam,Msg.LParam);
 Result := True;
end;
 
{---------------------------------------------------------}
 
// Send a couple integer/string
// to all the windows of a thread.
 
// Envoie un couple entier/chaîne
// à toutes les fenêtres d'un thread.
 
function  DTSendThreadCopyDataString
        (
        const Transmitter : HWND;
        const RecThread   : DWORD;
        const Ident       : Integer;
        const Str         : string
        ) : LongBool;
 begin
  Result := DTPerformThreadCopyDataString
                           (Transmitter, RecThread,
                            Ident,Str,@SendEnumWindowProc);
 end;
 
{---------------------------------------------------------}
 
// Constructor of the TDTMessager class.
 
// Constructeur de la classe TDTMessager.
 
constructor TDTMessager.Create(AOwner:TComponent);
 begin
  inherited;
  FOnMessage := nil;
  FOnRecString := nil;
  DTMessagerList.Add(Self);
  FEnabled := true;
 end;
 
{---------------------------------------------------------}
 
// Destructor of the TDTMessager class.
 
// Destructeur de la classe TDTMessager.
 
destructor TDTMessager.Destroy;
 var Idx : Integer;
 begin
  FEnabled := false;
  Idx := DTMessagerList.IndexOf(Self);
  if Idx >=0 then DTMessagerList.Delete(Idx);
  inherited;
 end;
 
{---------------------------------------------------------}
 
// TDTMessager Hook method.
 
// Méthode Hook de TDTMessager.
 
function TDTMessager.MessageHook(Code:Integer;wParm:WPARAM;
                                 lParm:LPARAM):Boolean;
 var Wnd : HWnd; Ident : Integer; Str:string;
 begin
  Result := False;
  if not FEnabled then Exit;
  if assigned(FOnMessage)
     then FOnMessage(Code,wParm,lParm,Result);
  if not( Result )
     and ( Code = WM_COPYDATA )
     and assigned( FOnRecString )
   then begin
         Wnd := HWnd( wParm );
         DTCopyDataToString
                   (PCopyDataStruct(lParm),Ident,Str);
         Result := True;
         FOnRecString(Wnd,Ident,Str,Result);
        end;
 end;
 
{---------------------------------------------------------}
 
// Global hook installed by the unit. See:
 
// Hook global installé par l'unité. Voir :
 
// msdn.microsoft.com/en-us/library/ms644975%28v=vs.85%29.aspx
 
function GlobalMessageHook(Code:Integer;wParm:WPARAM;
                           lParm:LPARAM):LRESULT;stdcall;
 var lI : Integer;
     lM : TCWPStruct;
     lC : TDTMessager;
     {$IFDEF DCC}
     lF : VCL.Forms.TCustomForm;
     lX : FMX.Forms.TCommonCustomForm;
     {$ELSE}
     lF : TCustomForm;
     {$ENDIF DCC}
 
 begin
 
  // Dispatch the message to ALL TDTMessager components,
  // placed on the form having the concerned handle.
 
  // Distribue le message à TOUS les composants TDTMessager
  // placés sur la fiche ayant le handle concerné.
 
  if (Code = HC_ACTION) and assigned(DTMessagerList)
   then
    begin
     lM := PCWPStruct(lParm)^;
     for lI := 0 to DTMessagerList.Count - 1
      do begin
          lC := TDTMessager(DTMessagerList[lI]);
          if assigned(lC) then
           begin
 
            {$IFDEF DCC}
 
            // Note my clever trick to determine if our
            // component is on a VCL or FMX form :)
 
            // Notez mon truc astucieux pour déterminer si
            // le composant est sur une fiche VCL ou FMX :)
 
            if (lC.Owner is VCL.Forms.TCustomForm)
             then
              begin
               lF := VCL.Forms.TCustomForm(lC.Owner);
               if lF.HandleAllocated
               and (lF.Handle = lM.hwnd)
                 then lC.MessageHook
                      (lM.message,lM.wParam,lM.lParam);
              end;
 
            if (lC.Owner is FMX.Forms.TCommonCustomForm)
             then
              begin
               lX := FMX.Forms.TCommonCustomForm(lC.Owner);
 
               // *** FmxHandleToHWND ***
 
               // This function retrieve Windows Handle
               // from the FMX internal format handle.
               // Precious for system programmation.
 
               // Cette fonction récupère le handle Windows
               // à partir du handle interne de la FMX.
               // Précieuse pour la programmation système.
 
               if FmxHandleToHWND(lX.Handle) = lM.hwnd
                 then lC.MessageHook
                      (lM.message,lM.wParam,lM.lParam);
              end;
 
            {$ELSE}
 
            if (lC.Owner is TCustomForm)
             then begin
                   lF := TCustomForm(lC.Owner);
                   if lF.HandleAllocated
                   and (lF.Handle = lM.hwnd)
                     then lC.MessageHook
                          (lM.message,lM.wParam,lM.lParam);
                  end;
 
            {$ENDIF DCC}
 
           end;
         end; // for lI ...
    end; // Code = HC_ACTION ...
  Result := CallNextHookEx(0,Code,wParm,lParm);
 end;
 
{---------------------------------------------------------}
 
procedure Register;
begin
  RegisterComponents('Capjack', [TDTMessager]);
end;
 
{---------------------------------------------------------}
 
var GlobalHookHandle : HHook = 0;
 
INITIALIZATION
 try
  DTMessagerList   := TList.Create;
 
  GlobalHookHandle := SetWindowsHookEx
          (WH_CALLWNDPROC,
           {$IFDEF FPC}HOOKPROC{$ENDIF}(@GlobalMessageHook),
           0, GetCurrentThreadId);
 finally
 end;
 
FINALIZATION
 try
  UnhookWindowsHookEx(GlobalHookHandle);
  if assigned(DTMessagerList) then DTMessagerList.Free;
 finally
 end;
 
END.
DTMessager: communicate between Windows applications

Sections

In the same section
