Walkie-talkie or How to communicate between two Delphi applications

Recently I've been researching different ways of communication between two applications. There are many ways to reach an application from another one. The challenge is to find the best one for your situation and one of the possible solutions is to use a call to the Windows API function SendMessage.

Windows is built around messages. You can create and send messages to windows (or controls) within a Delphi application. In addition, applications send messages to each other, and applications even send messages to themselves.

The SendMessage API function requires 4 arguments. The first argument is the handle of the window to which the message is addressed; the second argument-usually a symbolic constant-is the numeric value of the message; the third and fourth arguments, traditionally named wParam and lParam, carry any additional information needed by the message-in this case, which margin should be set and its new width, respectively. When more than two values are needed, they are usually gathered in a structure and its address is sent in the lParam argument.

The first task here is to establish the communication. To do this the client needs to find the servers window (it needs its window handle). The best way for that is the FindWindow API function. The FindWindow function retrieves the handle to the top-level window whose class name and window name match the specified strings. As a target window we will use Application's window. Why? because the global variable Application, of type TApplication, is in every Delphi Windows application. Application encapsulates your application as well as providing many functions that occur in the background of the program. In this case we already know that the value of the first parameter of FindWindow will be 'TApplication'. The secons is a window's title and it equal to Application.Title. Simple, isn't ?

My first solution was to use OnMessage event of TApplication class to trap the messages. However, this solution has a problem. The OnMessage event occurs when an application receives a Windows message. An OnMessage event handler allows an application to respond to messages other than those declared in the events for TApplication. Unfortunately, OnMessage only receives messages that are posted to the message queue, not those sent directly with the Windows API SendMessage function, so we need another way for it.

To solve this problem we can use one of the special methods of the TApplication class usually used internally for displaying Windows common dialogs. TApplication class has a special method called HookMainWindow that enables a non-VCL dialog box to receive messages sent to the application's main window (the window of TApplication, not main form of the application).

To encapsulate the complexities of messages handling I wrote a small component TpsvApplicationHook.

unit psvApplicationHook;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

  TOnHookMessage = procedure (Sender : TObject; var Message : TMessage; var Handled : boolean) of object;

  THookItem = class(TCollectionItem)
  private
    FHook : TWindowHook;
    FOnMessage : TOnHookMessage;
  protected
    function HookProc(var Message : TMessage) : boolean;
  public
    constructor Create(Collection : TCollection); override;
  published
    property OnMessage : TOnHookMessage read FOnMessage write FonMessage;
  end;

  THookItems = class(TCollection)
  private
    FOwner : TPersistent;
  protected
    function GetItem(Index : integer) : THookItem;
    procedure SetItem(Index : integer; Value : THookItem);
    function GetOwner : TPersistent; override;
  public
    constructor Create(AOwner : TPersistent; ItemClass : TCollectionItemClass);
    function Add : THookItem;
    property Items[Index : integer] : THookItem read GetItem write SetItem; default;
  end;

  TpsvApplicationHook = class(TComponent)
  private
    FItems : THookItems;
    procedure SetItems(const Value: THookItems);
  protected
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Activate;
    procedure Deactivate;
  published
    property Items : THookItems read FItems write SetItems;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TpsvApplicationHook]);
end;

{ THookItem }

constructor THookItem.Create(Collection: TCollection);
begin
  inherited;
  FHook := HookProc;
end;

function THookItem.HookProc(var Message: TMessage): boolean;
begin
  Result := false;
  if Assigned(FOnMessage) then
     FOnMessage(THookItems(Collection).FOwner, Message, Result);
end;

{ TpsvApplicationHook }

procedure TpsvApplicationHook.Activate;
var
 cnt : integer;
begin
  if Assigned(Application) then
  for cnt := 0 to FItems.Count - 1 do
   begin
     Application.HookMainWindow(FItems[cnt].FHook);
   end;
end;

constructor TpsvApplicationHook.Create(AOwner: TComponent);
begin
  inherited;
  FItems := THookItems.Create(Self, THookItem);
end;

procedure TpsvApplicationHook.Deactivate;
var
 cnt : integer;
begin
  if Assigned(Application) then
  for cnt := 0 to FItems.Count - 1 do
   begin
     Application.UnHookMainWindow(FItems[cnt].FHook);
   end;
end;

destructor TpsvApplicationHook.Destroy;
begin
  if (not (csDesigning in ComponentState) ) then
   Deactivate;
  FItems.Free;
  inherited;
end;

procedure TpsvApplicationHook.SetItems(const Value: THookItems);
begin
  FItems.Assign(Value);
end;

{ THookItems }

function THookItems.Add: THookItem;
begin
  Result := THookItem(inherited Add);
end;

constructor THookItems.Create(AOwner: TPersistent;
  ItemClass: TCollectionItemClass);
begin
  inherited Create(ItemClass);
  FOwner := AOwner;
end;

function THookItems.GetItem(Index: integer): THookItem;
begin
  Result := THookItem(inherited GetItem(Index));
end;

function THookItems.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure THookItems.SetItem(Index: integer; Value: THookItem);
begin
  inherited SetItem(Index, Value);
end;

end.

Okay, down to business. Sometimes would be very useful to centralize processing of the events that apply to the application as a whole. I will show how we can use TpsvApplicationHook in standalone Delphi application to create own "processing center".

unit StandaloneExample;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, psvApplicationHook;

type
  TfrmHookTest = class(TForm)
    psvApplicationHook: TpsvApplicationHook;
    btnSendMessage: TButton;
    btnActivateHook: TButton;
    btnDeactivateHook: TButton;
    procedure ProcessHookMessage(Sender: TObject;
      var Message: TMessage; var Handled: Boolean);
    procedure btnSendMessageClick(Sender: TObject);
    procedure btnActivateHookClick(Sender: TObject);
    procedure btnDeactivateHookClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmHookTest: TfrmHookTest;

implementation

{$R *.DFM}

const
  WM_MY_MESSAGE = WM_USER +1;

procedure TfrmHookTest.ProcessHookMessage(Sender: TObject;
  var Message: TMessage; var Handled: Boolean);
begin
  if Message.Msg = WM_MY_MESSAGE then
   begin
     ShowMessage('I received a message!');
   end;
end;

procedure TfrmHookTest.btnSendMessageClick(Sender: TObject);
begin
  SendMessage(Application.Handle, WM_MY_MESSAGE, 0, 0);
end;

procedure TfrmHookTest.btnActivateHookClick(Sender: TObject);
begin
  psvApplicationHook.Activate;
end;

procedure TfrmHookTest.btnDeactivateHookClick(Sender: TObject);
begin
   psvApplicationHook.Deactivate;
end;

end.

Next example shows communication between two applications. Client application will send custom message messages to server and Server will receive and process it using TpsvApplicationHook component. Here is the code of the server application:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  psvApplicationHook, StdCtrls;

type
  TfrmTestServer = class(TForm)
    psvApplicationHook: TpsvApplicationHook;
    LogMemo: TMemo;
    procedure ProcessCustomMessage(Sender: TObject; var Message: TMessage;
      var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MyMsg : UINT;
  end;

var
  frmTestServer: TfrmTestServer;

implementation

{$R *.DFM}

procedure TfrmTestServer.ProcessCustomMessage(Sender: TObject;
  var Message: TMessage; var Handled: Boolean);
begin
  if Message.Msg = MyMsg then
   begin
     LogMemo.Lines.Add(Format('%s : new message was received', [DateTimeToStr(Now)]));
     Handled := true;
   end;
end;


procedure TfrmTestServer.FormCreate(Sender: TObject);
var
 NewHook : THookItem;
begin
  MyMsg := RegisterWindowMessage('MyMessage');
  NewHook := psvApplicationHook.Items.Add;
  NewHook.OnMessage := ProcessCustomMessage;
  psvApplicationHook.Activate;
end;

end.

As a last step we have to create a client application that will send custom messages to the server application.

unit ClientMainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TfrmClient = class(TForm)
    btnSendMessage: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnSendMessageClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MyMsg : UINT;
    ServerApplicationHandle : THandle;
  end;

var
  frmClient: TfrmClient;

implementation

{$R *.DFM}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
  MyMsg := RegisterWindowMessage('MyMessage');
  ServerApplicationHandle := FindWindow('TApplication', 'Project1');
end;

procedure TfrmClient.btnSendMessageClick(Sender: TObject);
begin
  SendMessage(ServerApplicationHandle, MyMsg, 0, 0);
end;

end.