How to sync Indy's server? - delphi

Question

I want to sync Indy's TIdTCPServer's OnExecute, according to this question's example, but I don't receive the strings. Before I sent the strings directly from the server's execute, the client did receive them, so I'm fairly sure there's not a problem on that side.
Because I need a context to write lines to the buffer, the ServerSync contains an attribute that is to which the context of the execute procedure is assigned.
Server form:
unit ServerForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer, IdContext;
type
TForm1 = class(TForm)
Button1: TButton;
Server: TIdTCPServer;
memMessages: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Execute(AContext: TIdContext);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses ServerSync;
{$R *.dfm}
procedure TForm1.Execute(AContext: TIdContext);
var
Sync : TServerSync;
begin
Sync := TServerSync.Create(AContext);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Server := TIdTCPServer.Create;
Server.Bindings.Add.IP:= '0.0.0.0';
Server.Bindings.Add.Port:= 1990;
Server.OnExecute := Execute;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
memMessages.Lines.Add('Activated Server.');
Server.Active := True;
except
on E : Exception do
ShowMessage( E.ClassName + ' error raised, with message: ' + E.Message );
end;
end;
end.
Server Sync:
unit ServerSync;
interface
uses
IdContext, IdSync;
type
TServerSync = class(TIdSync)
constructor Create( AContext : TIdContext ); overload;
private
FContext : TIdContext;
protected
procedure DoSynchronize; override;
end;
implementation
constructor TServerSync.Create(AContext: TIdContext);
begin
inherited;
FContext := AContext;
end;
procedure TServerSync.DoSynchronize;
begin
FContext.Connection.IOHandler.WriteLn('Synced Hello World');
end;
end.
Client:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, FMX.Layouts,
FMX.Memo, FMX.StdCtrls, IdGlobal, IdIntercept;
type
TpocForm1 = class(TForm)
ButtonConnect: TButton;
ButtonDisconnect: TButton;
Memo1: TMemo;
procedure ButtonConnectClick(Sender: TObject);
procedure ButtonDisconnectClick(Sender: TObject);
procedure AddLine(text : String);
private
public
{ Public declarations }
end;
TpocTCPClientThread = class(TThread)
TCPClient: TIdTCPClient;
protected
procedure Execute; override;
procedure AddLineToMemo;
procedure Connect;
procedure Disconnect;
end;
var
pocForm1: TpocForm1;
implementation
{$R *.fmx}
Const
PC_IP = '192.168.32.85';
PORT = 1990;
var
thread: TpocTCPClientThread;
procedure TpocForm1.ButtonConnectClick(Sender: TObject);
begin
Memo1.Lines.Add('Client connected with server');
thread:= TpocTCPClientThread.Create(False);
end;
procedure TpocForm1.ButtonDisconnectClick(Sender: TObject);
begin
thread.Terminate;
thread.WaitFor;
FreeAndNil(thread);
Memo1.Lines.Add('Client disconnected from server');
end;
procedure TpocForm1.AddLine(text : String);
begin
Memo1.Lines.Add(text);
end;
procedure TpocTCPClientThread.Execute();
begin
Connect;
while not Terminated do
begin
Synchronize(AddLineToMemo);
end;
Disconnect;
end;
procedure TpocTCPClientThread.AddLineToMemo;
begin
pocForm1.AddLine(TCPClient.IOHandler.ReadLn(IndyTextEncoding_OSDefault()));
end;
procedure TpocTCPClientThread.Connect;
begin
TCPClient := TIdTCPClient.Create;
TCPClient.Host := PC_IP;
TCPClient.Port := PORT;
TCPClient.Connect;
end;
procedure TpocTCPClientThread.Disconnect;
begin
TCPClient.Disconnect;
TCPClient.Free;
end;
end.

Answer 1

You are making MANY mistakes in this code.
The server code is creating 2 Bindings entries when it should only be creating 1 entry.
The server code is never calling TIdSync.Synchronize(), which is what queues your overridden DoSynchronize() method to be called by the main thread.
The server code is leaking many TServerSync objects. OnExecute is a looped event, it is called in a continuous loop for the lifetime of the connection. You are never calling Free() on the TServerSync objects that you create on each loop iteration.
The server code is calling IOHandler.WriteLn() inside your synchronized DoSynchronize() code, and your client code is calling IOHandler.ReadLn() inside your synchronized AddLineToMemo() code. They do not belong there! Socket I/O belongs in your OnExecute handlers, not synchronized. Use synchronizaton to access shared data, update UIs, etc, not to perform socket I/O.
In short, all this code needs to be re-written. Try something more like this instead:
Server:
unit ServerForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdTCPServer, IdContext;
type
TForm1 = class(TForm)
Button1: TButton;
Server: TIdTCPServer;
memMessages: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Execute(AContext: TIdContext);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
ServerSync;
{$R *.dfm}
procedure TForm1.Execute(AContext: TIdContext);
var
Sync : TServerSync;
begin
Sync := TServerSync.Create(AContext);
try
Sync.Synchronize;
AContext.Connection.IOHandler.WriteLn(Sync.Value);
finally
Sync.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Server := TIdTCPServer.Create(Self);
with Server.Bindings.Add do begin
IP := '0.0.0.0';
Port:= 1990;
end;
Server.OnExecute := Execute;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Server.Active then Exit;
try
Server.Active := True;
except
on E : Exception do
begin
ShowMessage( E.ClassName + ' error raised, with message: ' + E.Message );
Exit;
end;
end;
memMessages.Lines.Add('Activated Server.');
end;
end.
unit ServerSync;
interface
uses
IdSync;
type
TServerSync = class(TIdSync)
protected
procedure DoSynchronize; override;
end;
implementation
procedure TServerSync.DoSynchronize;
begin
// this is called in the context of the main UI thread, do something ...
Value := 'Synced Hello World';
end;
end.
Client:
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, FMX.Layouts,
FMX.Memo, FMX.StdCtrls, IdGlobal, IdIntercept;
type
TpocForm1 = class(TForm)
ButtonConnect: TButton;
ButtonDisconnect: TButton;
Memo1: TMemo;
procedure ButtonConnectClick(Sender: TObject);
procedure ButtonDisconnectClick(Sender: TObject);
procedure AddLine(text : String);
private
public
{ Public declarations }
end;
var
pocForm1: TpocForm1;
implementation
{$R *.fmx}
const
PC_IP = '192.168.32.85';
PORT = 1990;
type
TpocTCPClientThread = class(TThread)
private
TCPClient: TIdTCPClient;
FLine: string;
procedure AddLineToMemo(text: string);
procedure DoAddLineToMemo;
protected
procedure Execute; override;
public
constructor Create; reintroduce;
destructor Destroy; override;
end;
var
thread: TpocTCPClientThread = nil;
procedure TpocForm1.ButtonConnectClick(Sender: TObject);
begin
if thread = nil then
thread := TpocTCPClientThread.Create(False);
end;
procedure TpocForm1.ButtonDisconnectClick(Sender: TObject);
begin
if thread = nil then Exit;
thread.Terminate;
thread.WaitFor;
FreeAndNil(thread);
end;
procedure TpocForm1.AddLine(text : String);
begin
Memo1.Lines.Add(text);
end;
constructor TpocTCPClientThread.Create;
begin
inherited Create(False);
TCPClient := TIdTCPClient.Create;
TCPClient.Host := PC_IP;
TCPClient.Port := PORT;
end;
destructor TpocTCPClientThread.Destroy;
begin
TCPClient.Free;
inherited;
end;
procedure TpocTCPClientThread.Execute;
begin
try
TCPClient.Connect;
except
on E: Exception do
AddLineToMemo('Unable to connect to server. ' + E.ClassName + ' error raised, with message: ' + E.Message );
Exit;
end;
try
try
AddLineToMemo('Client connected to server');
TCPClient.IOHandler.DefStringEncoding := IndyTextEncoding_OSDefault;
while not Terminated do
begin
AddLineToMemo(TCPClient.IOHandler.ReadLn);
end;
except
on E: Exception do
AddLineToMemo( E.ClassName + ' error raised, with message: ' + E.Message );
end;
finally
TCPClient.Disconnect;
AddLineToMemo('Client disconnected from server');
end;
end;
procedure TpocTCPClientThread.AddLineToMemo(text: string);
begin
FLine := text;
Synchronize(DoAddLineToMemo);
end;
procedure TpocTCPClientThread.DoAddLineToMemo;
begin
pocForm1.AddLine(FLine);
end;
end.