How to sync Indy's server?

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.

score 5 · Answer 1 · answered Mar 20 '15 at 18:36

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.

How to sync Indy's server?

1 Answers1