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.
1 unit psvApplicationHook;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
7
8 type
9
10 TOnHookMessage = procedure (Sender : TObject; var message : TMessage; var Handled
11 : boolean) of object;
12
13 THookItem = class(TCollectionItem)
14 private
15 FHook : TWindowHook;
16 FOnMessage : TOnHookMessage;
17 protected
18 function HookProc(var message : TMessage) : boolean;
19 public
20 constructor Create(Collection : TCollection); override;
21 published
22 property OnMessage : TOnHookMessage read FOnMessage write FonMessage;
23 end;
24
25 THookItems = class(TCollection)
26 private
27 FOwner : TPersistent;
28 protected
29 function GetItem(Index : integer) : THookItem;
30 procedure SetItem(Index : integer; Value : THookItem);
31 function GetOwner : TPersistent; override;
32 public
33 constructor Create(AOwner : TPersistent; ItemClass : TCollectionItemClass);
34 function Add : THookItem;
35 property Items[Index : integer] : THookItem read GetItem write SetItem; default;
36 end;
37
38 TpsvApplicationHook = class(TComponent)
39 private
40 FItems : THookItems;
41 procedure SetItems(const Value: THookItems);
42 protected
43 public
44 constructor Create(AOwner : TComponent); override;
45 destructor Destroy; override;
46 procedure Activate;
47 procedure Deactivate;
48 published
49 property Items : THookItems read FItems write SetItems;
50 end;
51
52 procedure register;
53
54 implementation
55
56 procedure register;
57 begin
58 RegisterComponents('Additional', [TpsvApplicationHook]);
59 end;
60
61 { THookItem }
62
63 constructor THookItem.Create(Collection: TCollection);
64 begin
65 inherited;
66 FHook := HookProc;
67 end;
68
69 function THookItem.HookProc(var message: TMessage): boolean;
70 begin
71 Result := false;
72 if Assigned(FOnMessage) then
73 FOnMessage(THookItems(Collection).FOwner, message, Result);
74 end;
75
76 { TpsvApplicationHook }
77
78 procedure TpsvApplicationHook.Activate;
79 var
80 cnt : integer;
81 begin
82 if Assigned(Application) then
83 for cnt := 0 to FItems.Count - 1 do
84 begin
85 Application.HookMainWindow(FItems[cnt].FHook);
86 end;
87 end;
88
89 constructor TpsvApplicationHook.Create(AOwner: TComponent);
90 begin
91 inherited;
92 FItems := THookItems.Create(Self, THookItem);
93 end;
94
95 procedure TpsvApplicationHook.Deactivate;
96 var
97 cnt : integer;
98 begin
99 if Assigned(Application) then
100 for cnt := 0 to FItems.Count - 1 do
101 begin
102 Application.UnHookMainWindow(FItems[cnt].FHook);
103 end;
104 end;
105
106 destructor TpsvApplicationHook.Destroy;
107 begin
108 if (not (csDesigning in ComponentState) ) then
109 Deactivate;
110 FItems.Free;
111 inherited;
112 end;
113
114 procedure TpsvApplicationHook.SetItems(const Value: THookItems);
115 begin
116 FItems.Assign(Value);
117 end;
118
119 { THookItems }
120
121 function THookItems.Add: THookItem;
122 begin
123 Result := THookItem(inherited Add);
124 end;
125
126 constructor THookItems.Create(AOwner: TPersistent;
127 ItemClass: TCollectionItemClass);
128 begin
129 inherited Create(ItemClass);
130 FOwner := AOwner;
131 end;
132
133 function THookItems.GetItem(Index: integer): THookItem;
134 begin
135 Result := THookItem(inherited GetItem(Index));
136 end;
137
138 function THookItems.GetOwner: TPersistent;
139 begin
140 Result := FOwner;
141 end;
142
143 procedure THookItems.SetItem(Index: integer; Value: THookItem);
144 begin
145 inherited SetItem(Index, Value);
146 end;
147
148 end.
149 {Okay, down to business. Sometimes would be very useful to centralize processing of
150 the events that apply to the application as a whole. I will show how we can use
151 TpsvApplicationHook in standalone Delphi application to create own "processing
152 center". }
153 unit StandaloneExample;
154
155 interface
156
157 uses
158 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
159 StdCtrls, psvApplicationHook;
160
161 type
162 TfrmHookTest = class(TForm)
163 psvApplicationHook: TpsvApplicationHook;
164 btnSendMessage: TButton;
165 btnActivateHook: TButton;
166 btnDeactivateHook: TButton;
167 procedure ProcessHookMessage(Sender: TObject;
168 var message: TMessage; var Handled: Boolean);
169 procedure btnSendMessageClick(Sender: TObject);
170 procedure btnActivateHookClick(Sender: TObject);
171 procedure btnDeactivateHookClick(Sender: TObject);
172 private
173 { Private declarations }
174 public
175 { Public declarations }
176 end;
177
178 var
179 frmHookTest: TfrmHookTest;
180
181 implementation
182
183 {$R *.DFM}
184
185 const
186 WM_MY_MESSAGE = WM_USER +1;
187
188 procedure TfrmHookTest.ProcessHookMessage(Sender: TObject;
189 var message: TMessage; var Handled: Boolean);
190 begin
191 if message.Msg = WM_MY_MESSAGE then
192 begin
193 ShowMessage('I received a message!');
194 end;
195 end;
196
197 procedure TfrmHookTest.btnSendMessageClick(Sender: TObject);
198 begin
199 SendMessage(Application.Handle, WM_MY_MESSAGE, 0, 0);
200 end;
201
202 procedure TfrmHookTest.btnActivateHookClick(Sender: TObject);
203 begin
204 psvApplicationHook.Activate;
205 end;
206
207 procedure TfrmHookTest.btnDeactivateHookClick(Sender: TObject);
208 begin
209 psvApplicationHook.Deactivate;
210 end;
211
212 end.
213
214 {Next example shows communication between two applications. Client application will
215 send custom message messages to server and Server will receive and process it using
216 TpsvApplicationHook component. Here is the code of the server application: }
217 unit Unit1;
218
219 interface
220
221 uses
222 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
223 psvApplicationHook, StdCtrls;
224
225 type
226 TfrmTestServer = class(TForm)
227 psvApplicationHook: TpsvApplicationHook;
228 LogMemo: TMemo;
229 procedure ProcessCustomMessage(Sender: TObject; var message: TMessage;
230 var Handled: Boolean);
231 procedure FormCreate(Sender: TObject);
232 private
233 { Private declarations }
234 public
235 { Public declarations }
236 MyMsg : UINT;
237 end;
238
239 var
240 frmTestServer: TfrmTestServer;
241
242 implementation
243
244 {$R *.DFM}
245
246 procedure TfrmTestServer.ProcessCustomMessage(Sender: TObject;
247 var message: TMessage; var Handled: Boolean);
248 begin
249 if message.Msg = MyMsg then
250 begin
251 LogMemo.Lines.Add(Format('%s : new message was received',
252 [DateTimeToStr(Now)]));
253 Handled := true;
254 end;
255 end;
256
257
258 procedure TfrmTestServer.FormCreate(Sender: TObject);
259 var
260 NewHook : THookItem;
261 begin
262 MyMsg := RegisterWindowMessage('MyMessage');
263 NewHook := psvApplicationHook.Items.Add;
264 NewHook.OnMessage := ProcessCustomMessage;
265 psvApplicationHook.Activate;
266 end;
267
268 end.
269
270 {As a last step we have to create a client application that will send custom
271 messages to the server application. }
272 unit ClientMainForm;
273
274 interface
275
276 uses
277 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
278 StdCtrls;
279
280 type
281 TfrmClient = class(TForm)
282 btnSendMessage: TButton;
283 procedure FormCreate(Sender: TObject);
284 procedure btnSendMessageClick(Sender: TObject);
285 private
286 { Private declarations }
287 public
288 { Public declarations }
289 MyMsg : UINT;
290 ServerApplicationHandle : THandle;
291 end;
292
293 var
294 frmClient: TfrmClient;
295
296 implementation
297
298 {$R *.DFM}
299
300 procedure TfrmClient.FormCreate(Sender: TObject);
301 begin
302 MyMsg := RegisterWindowMessage('MyMessage');
303 ServerApplicationHandle := FindWindow('TApplication', 'Project1');
304 end;
305
306 procedure TfrmClient.btnSendMessageClick(Sender: TObject);
307 begin
308 SendMessage(ServerApplicationHandle, MyMsg, 0, 0);
309 end;
310
311 end.
|
