Communication entre deux Executables ?

**QAYS** · 11/05/2005, 10h50

Bonjour,

J'ai ouïe dire qu'il était possible de créer une application WINDOWS (avec delphi) qui aurait la particularité de communiquer via TCP/IP avec un autre EXE.

Je m'explique, en fait je souhaite créer une application (MASTER_APP.EXE)avec une base de Données qui serait stockée sur un serveur à Paris par ex. et avoir une autre application (SLAVE_APP.EXE) sur une poste située à Lyon par ex. et faire en sorte que SLAVE_APP.EXE communique avec MASTER_APP.EXE via TCP/IP ou tout autre protocole de communication (style Internet).

J'ai tenté de rechercher sur Internet des informations, mais je n'en trouve pas.

Merci de votre aide
Cordialement QAYS

**QAYS** · 11/05/2005, 11h40

Rebonjour,

j'ai continué les recherches et il me semble que le composant DDE , puisse répondre à mes besoin
http://<br /> http://fbeaulieu.deve...dde.html<br />

Ai je raison ?

Cordialement

**Bloon** · 11/05/2005, 12h06

Non, pour ton cas, TCP/IP est bien adapté, il faut que tu utilises des composants comme Indy (fournis avec Delphi) ou ICS.

Regarde aussi du côté des Mailslots.

Bloon

**QAYS** · 11/05/2005, 13h06

Bonjour,

Merci pour votre réponse.

J'ai delphi 7 proffessionelle, je suis au bureau actuellement, je vérifierai si ce composant et fourni ou bien s'il faut que j'achete la version entreprise.

Cordialement
kaiss LEMMOUCHI

**Reisubar** · 11/05/2005, 13h20

Hello,

J'ai déjà fait ceci avec Indy. Une DLL gère un pool de serveurs qui sont acquis par les applications via une fonction CreateServer . Elles demandent à être informés de la réception de messages via une méthode particulière (chez moi c'est HookMessage) qui attends une fonction de callback à rappeller lors de la reception du message. Côté client, une fonction SendMessage permet d'envoyer un message à un serveur quelconque.

Si ca t'intéresse je peux poster le code et/ou le binaire.

A.R.

**Clorish** · 11/05/2005, 14h26

Moi ca m'interresse .. je cherche justement a faire qque chose de similaire (mais en plus simple ;p).

Merci.

**Lung** · 11/05/2005, 14h32

Envoyé par Clorish

Moi ca m'interresse .. je cherche justement a faire qque chose de similaire (mais en plus simple ;p).

Merci.

Je suis preneur, moi aussi.

**Reisubar** · 11/05/2005, 14h37

Désolé, c'est long. Je mettrais peut être ca sur mon espace perso quand j'aurais du temps avec des jolis commentaires.

Le code se compose de deux unités et du projet. A l'origine c'est une DLL. J'ai épuré quelques passages inutiles ou liés à mon application - le code n'est peut être pas compilable directement mais en tout cas ca peut donner des idées :-)

Unité serveur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
unit thMessageServer;
 
//msg server for thbackup - Adrien Reboisson
//
// rev 1. Seems to work.
 
interface
 
uses SysUtils, Classes, Contnrs, SyncObjs, IdBaseComponent, IdContext, IdComponent, IdTCPServer,
  IdCmdTCPServer, libthmsgrintf;
 
type
  TThMessageBinding = class
  private
    FMessage: string;
    FOnExecute: TThMessageCallbackProc;
  public
    property MessageHandled: string read FMessage write FMessage;
    property OnExecute: TThMessageCallbackProc read FOnExecute write FOnExecute;
    function TryExecute(const AMessageContent: string): Boolean;
    constructor Create(AMessage: string; AHandler: TThMessageCallbackProc);
  end;
 
  TThMessagesList = class (TObjectList)
  private
    FLock: TCriticalSection;
    function Find(const S: string; var Index: Integer): Boolean;
    function GetItem(Index: Integer): TThMessageBinding;
    procedure SetItem(Index: Integer; const Value: TThMessageBinding);
  public
    function HookMessage(const AMessage: string; AHandler: TThMessageCallbackProc): Boolean;
    function UnhookMessage(const AMessage: string): Boolean;
    function Execute(const AMessage, AContent: string): Boolean;
    property Items[Index: Integer]: TThMessageBinding read GetItem write SetItem; default;
    procedure Lock;
    procedure Unlock;
    constructor Create;
    destructor Destroy; override;
  end;
 
  TThMessageServer = class (TIdTCPServer)
  private
    FMessagesList: TThMessagesList;
    FID: Integer;
  public
    procedure MessageRcvHandler(AContext: TIdContext);
    constructor Create;
    destructor Destroy; override;
    property ID: Integer read FID write FID;
    property MessagesList: TThMessagesList read FMessagesList write FMessagesList;
  end;
 
  TThServersList = class (TObjectList)
  private
    FLock: TCriticalSection;
    FHandleGenerator: Integer;
    function GetItem(Index: Integer): TThMessageServer;
    procedure SetItem(Index: Integer; const Value: TThMessageServer);
    function Find(const S: Integer; var Index: Integer): Boolean;
  public
    property Items[Index: Integer]: TThMessageServer read GetItem write SetItem; default;
    constructor Create;
    destructor Destroy; override;
    function CreateServer(const APort: Integer; const AAddress: string): Integer;
    function FreeServer(const AServerHandle: Integer): Boolean;
    function HookMessage(const AServerHandle: Integer; AMessage: string; AProc: Pointer): Boolean;
    function UnhookMessage(const AServerHandle: Integer; AMessage: string): Boolean;
  end;
 
var
  GServersList: TThServersList = nil;
 
implementation
 
uses IdSocketHandle;
 
{ TThMessageServer }
 
constructor TThMessageServer.Create;
begin
  inherited Create;
  OnExecute := MessageRcvHandler;
  FMessagesList := TThMessagesList.Create;
end;
 
destructor TThMessageServer.Destroy;
begin
  try
    Active := False;
    FMessagesList.Free;
    inherited;
  except
  end;
end;
 
procedure TThMessageServer.MessageRcvHandler(AContext: TIdContext);
var
  I : Integer;
  LLine, LMessage, LMessageContent: string;
begin
  LLine := Trim(AContext.Connection.IOHandler.ReadLn);
  I := Pos(' ', LLine);
  if I > 0 then
  begin
    LMessage := Copy(LLine, 1, I - 1);
    LMessageContent := Copy(LLine, I + 1, Length(LLine));
    FMessagesList.Execute(LMessage, LMessageContent);
  end;
end;
 
{ TThMessageBinding }
 
constructor TThMessageBinding.Create(AMessage: string;
  AHandler: TThMessageCallbackProc);
begin
  inherited Create;
  FMessage := AMessage;
  FOnExecute := AHandler;
end;
 
function TThMessageBinding.TryExecute(const AMessageContent: string): Boolean;
begin
  if Assigned(FOnExecute) then
  begin
    Result := True;
    FOnExecute(PChar(FMessage), PChar(AMessageContent));
  end else
    Result := False;
end;
 
{ TThMessagesList }
 
constructor TThMessagesList.Create;
begin
  inherited Create;
  FLock := TCriticalSection.Create;
end;
 
destructor TThMessagesList.Destroy;
begin
  FLock.Free;
  inherited;
end;
 
function TThMessagesList.Execute(const AMessage,
  AContent: string): Boolean;
var
  I: Integer;
begin
  Lock;
  try
    if Find(AMessage, I) then
      Result := Items[I].TryExecute(AContent)
    else
      Result := False;
  finally
    Unlock;
  end;
end;
 
function TThMessagesList.Find(const S: string;
  var Index: Integer): Boolean;
 var
  L, H, I : Integer;
  C: Integer;
begin
 { Warning: the list must be locked before calling Find() }
  Result := False;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := CompareStr(Items[I].MessageHandled, S);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
        Break;
      end;
    end;
  end;
  Index := L;
end;
 
function TThMessagesList.GetItem(Index: Integer): TThMessageBinding;
begin
  Result := TThMessageBinding(inherited GetItem(Index));
end;
 
function TThMessagesList.HookMessage(const AMessage: string;
  AHandler: TThMessageCallbackProc): Boolean;
var
  I: Integer;
  S: TThMessageBinding;
begin
  Lock;
  try
    if Find(AMessage, I) then
      Result := False { Already inserted }
    else
    begin
      S := TThMessageBinding.Create(AMessage, AHandler);
      Insert(I, S);
      Result := True;
    end;
  finally
    Unlock;
  end;
end;
 
procedure TThMessagesList.Lock;
begin
  FLock.Acquire;
end;
 
procedure TThMessagesList.SetItem(Index: Integer;
  const Value: TThMessageBinding);
begin
  inherited SetItem(Index, Value);
end;
 
function TThMessagesList.UnhookMessage(const AMessage: string): Boolean;
var
  I: Integer;
begin
  Lock;
  try
    if Find(AMessage, I) then
    begin
      Delete(I);
      Result := True;
    end
    else
      Result := False;
  finally
    Unlock;
  end;
end;
 
procedure TThMessagesList.Unlock;
begin
  FLock.Release;
end;
 
{ TThServersList }
 
constructor TThServersList.Create;
begin
  FLock := TCriticalSection.Create;
  FHandleGenerator := 0;
  inherited;
end;
 
function TThServersList.CreateServer(const APort: Integer; const AAddress: string): Integer;
var
  S: TThMessageServer;
  I: Integer;
begin
  Result := -1;
  S := nil;
  FLock.Acquire;
  try
    Inc(FHandleGenerator);
    try
      if not Find(FHandleGenerator, I) then
      begin
        S := TThMessageServer.Create;
        S.DefaultPort := APort;
        with S.Bindings.Add do
        begin
          IP := AAddress;
          Port := APort;
        end;
        S.Active := True;
        S.ID := FHandleGenerator;
        Insert(I, S);
        Result := S.ID;
      end else
        Result := -1;
    except
      if (S <> nil) then
        FreeAndNil(S);
    end;
  finally
    FLock.Release;
  end;
end;
 
destructor TThServersList.Destroy;
begin
  FLock.Free;
  inherited;
end;
 
function TThServersList.Find(const S: Integer;
  var Index: Integer): Boolean;
 var
  L, H, I : Integer;
  C: Integer;
begin
 { Warning: the list must be locked before calling Find() }
  Result := False;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Items[I].ID - S;
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
        Break;
      end;
    end;
  end;
  Index := L;
end;
 
function TThServersList.FreeServer(const AServerHandle: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  FLock.Acquire;
  try
    if Find(AServerHandle, I) then
    begin
      Items[I].Active := False;
      Delete(I);
      Result := True;
    end;
  finally
    FLock.Release;
  end;
end;
 
function TThServersList.GetItem(Index: Integer): TThMessageServer;
begin
  Result := TThMessageServer(inherited GetItem(Index));
end;
 
function TThServersList.HookMessage(const AServerHandle: Integer;
  AMessage: string; AProc: Pointer): Boolean;
var
  I: Integer;
begin
  Result := False;
  FLock.Acquire;
  try
    if Find(AServerHandle, I) then
      Result := Items[I].MessagesList.HookMessage(AMessage, TThMessageCallbackProc(AProc));
  finally
    FLock.Release;
  end;
end;
 
procedure TThServersList.SetItem(Index: Integer;
  const Value: TThMessageServer);
begin
  inherited SetItem(Index, Value);
end;
 
function TThServersList.UnhookMessage(const AServerHandle: Integer;
  AMessage: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  FLock.Acquire;
  try
    if Find(AServerHandle, I) then
      Result := Items[I].MessagesList.UnhookMessage(AMessage);
  finally
    FLock.Release;
  end;
end;
 
initialization
  GServersList := TThServersList.Create;
 
finalization
  if Assigned(GServersList) then
    FreeAndNil(GServersList);
 
end.

L'unité qui envoie des messages clients :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
unit thMessageClient;
 
//msg client for thbackup - Adrien Reboisson
//
// rev 1. Seems to work.
 
 
interface
 
uses libthmsgrintf, IdTCPClient;
 
function SendTHBMessage(AServer: TThMsgServer; ARawMessage: PChar): Boolean;
 
implementation
 
uses libthmngtintf;
 
function SendTHBMessage(AServer: TThMsgServer; ARawMessage: PChar): Boolean;
var
  S: TIdTCPClient;
begin
  try
    S := TIdTCPClient.Create;
    S.CreateIOHandler();
    try
      S.Host := AServer.Host;
      S.Port := AServer.Port;
      S.Connect;
      try
        S.IOHandler.WriteLn(ARawMessage);
        Result := True;
      finally
        S.Disconnect;
      end;
    finally
      S.Free;
    end;
  except
    Result := False;
  end;
end;

Puis le projet en lui même qui exporte les fonctions suivantes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
 
//type commun
 
  TThMessageCallbackProc = procedure (AMessage: PChar; AMessageContent: PChar); stdcall;
 
  function thbDestroyMessageServer(AServerHandle: Integer): Boolean;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  begin
    Result := GServersList.FreeServer(AServerHandle);
  end;
 
  function thbHookMessage(AServerHandle: Integer; AMessage: PChar; ACallBack: Pointer): Boolean;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  begin
    Result := GServersList.HookMessage(AServerHandle, AMessage, ACallBack);
  end;
 
  function thbUnhookMessage(AServerHandle: Integer; AMessage: PChar): Boolean;
  {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
  begin
    Result := GServersList.UnhookMessage(AServerHandle, AMessage);
  end;

La fonction d'envoi de messages n'est pas interfacée dans le code posté car elle passe par diverses moulinettes dont le code aurait alourdi l'exemple. Il faudrait néanmoins le faire pour pouvoir envoyer des messages via la DLL.

J'attends vos questions ;-)

**Clorish** · 11/05/2005, 14h41

le code n'est peut être pas compilable directement mais en tout cas ca peut donner des idées Smile

A la base ... c'ets ca qui nous interesse (les idees)

Communication entre deux Executables ?

Langage Delphi

Discussions similaires

Partager

Partager