firemonkey idTcp and Record












0














Good afternoon.



The client sends a message to the server, and the server responds by sending two messages to the client.



The client sees these messages, but the memo records the very first value sent by the server.



Prompt in what the reason



Server ----------------------------------------------------



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IDGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
MainPort := TIdTCPServer.Create;
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;
MainPort.Bindings.Add.IP := '127.0.0.1';
MainPort.Bindings.Add.Port := 6000;
MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
Progress: string;
Client : TIdTCPClient;
FQueue : TThreadedQueue<TRec_Data>;
protected
procedure Execute; override;
public
constructor Create(const AQueue : TThreadedQueue<TRec_Data>);
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TThreadedQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue:=TThreadedQueue<TRec_Data>.Create(100, 1000, 10);

Timer:=TTimer.Create(Self);
Timer.Interval:=100;
Timer.OnTimer:=OnTimer;
Timer.Enabled:=True;

FMyThread:=TMyThread.Create(FQueue);
FMyThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free
end;
if Assigned(Timer) then
Timer.Free;
if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
Var ARec : TRec_Data;
begin
// while FQueue.PopItem(ARec) = TWaitResult.wrSignaled do или
if FQueue.PopItem(ARec) = TWaitResult.wrSignaled then
Form1.Memo1.Lines.Insert(0, ARec.Flag);
end;

constructor TMyThread.Create(const AQueue : TThreadedQueue<TRec_Data>);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
inherited Create(true);

FQueue:=AQueue;

Client := TIdTCPClient.Create(nil);
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.Connect;

// Передаем данные
if Client.Connected = True then
begin
Rec.Flag := 'addUser';

Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);
end;
end;

destructor TMyThread.Destroy;
begin
if Assigned(Client) then
Client.Free;
inherited;
end;

procedure TMyThread.Execute;
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
while Not Terminated do
begin
if Client.Connected then
begin
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
Progress := Rec.Flag;
// Synchronize(SetProgress);
FQueue.PushItem(Rec);
end
else
Client.Connect;
TThread.Sleep(10);
end;
end;


end.









share|improve this question




















  • 1




    Sorry, what exactly is your question?
    – Sherlock70
    Nov 23 '18 at 10:27
















0














Good afternoon.



The client sends a message to the server, and the server responds by sending two messages to the client.



The client sees these messages, but the memo records the very first value sent by the server.



Prompt in what the reason



Server ----------------------------------------------------



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IDGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
MainPort := TIdTCPServer.Create;
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;
MainPort.Bindings.Add.IP := '127.0.0.1';
MainPort.Bindings.Add.Port := 6000;
MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
Progress: string;
Client : TIdTCPClient;
FQueue : TThreadedQueue<TRec_Data>;
protected
procedure Execute; override;
public
constructor Create(const AQueue : TThreadedQueue<TRec_Data>);
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TThreadedQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue:=TThreadedQueue<TRec_Data>.Create(100, 1000, 10);

Timer:=TTimer.Create(Self);
Timer.Interval:=100;
Timer.OnTimer:=OnTimer;
Timer.Enabled:=True;

FMyThread:=TMyThread.Create(FQueue);
FMyThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free
end;
if Assigned(Timer) then
Timer.Free;
if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
Var ARec : TRec_Data;
begin
// while FQueue.PopItem(ARec) = TWaitResult.wrSignaled do или
if FQueue.PopItem(ARec) = TWaitResult.wrSignaled then
Form1.Memo1.Lines.Insert(0, ARec.Flag);
end;

constructor TMyThread.Create(const AQueue : TThreadedQueue<TRec_Data>);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
inherited Create(true);

FQueue:=AQueue;

Client := TIdTCPClient.Create(nil);
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.Connect;

// Передаем данные
if Client.Connected = True then
begin
Rec.Flag := 'addUser';

Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);
end;
end;

destructor TMyThread.Destroy;
begin
if Assigned(Client) then
Client.Free;
inherited;
end;

procedure TMyThread.Execute;
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
while Not Terminated do
begin
if Client.Connected then
begin
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
Progress := Rec.Flag;
// Synchronize(SetProgress);
FQueue.PushItem(Rec);
end
else
Client.Connect;
TThread.Sleep(10);
end;
end;


end.









share|improve this question




















  • 1




    Sorry, what exactly is your question?
    – Sherlock70
    Nov 23 '18 at 10:27














0












0








0







Good afternoon.



The client sends a message to the server, and the server responds by sending two messages to the client.



The client sees these messages, but the memo records the very first value sent by the server.



Prompt in what the reason



Server ----------------------------------------------------



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IDGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
MainPort := TIdTCPServer.Create;
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;
MainPort.Bindings.Add.IP := '127.0.0.1';
MainPort.Bindings.Add.Port := 6000;
MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
Progress: string;
Client : TIdTCPClient;
FQueue : TThreadedQueue<TRec_Data>;
protected
procedure Execute; override;
public
constructor Create(const AQueue : TThreadedQueue<TRec_Data>);
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TThreadedQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue:=TThreadedQueue<TRec_Data>.Create(100, 1000, 10);

Timer:=TTimer.Create(Self);
Timer.Interval:=100;
Timer.OnTimer:=OnTimer;
Timer.Enabled:=True;

FMyThread:=TMyThread.Create(FQueue);
FMyThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free
end;
if Assigned(Timer) then
Timer.Free;
if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
Var ARec : TRec_Data;
begin
// while FQueue.PopItem(ARec) = TWaitResult.wrSignaled do или
if FQueue.PopItem(ARec) = TWaitResult.wrSignaled then
Form1.Memo1.Lines.Insert(0, ARec.Flag);
end;

constructor TMyThread.Create(const AQueue : TThreadedQueue<TRec_Data>);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
inherited Create(true);

FQueue:=AQueue;

Client := TIdTCPClient.Create(nil);
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.Connect;

// Передаем данные
if Client.Connected = True then
begin
Rec.Flag := 'addUser';

Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);
end;
end;

destructor TMyThread.Destroy;
begin
if Assigned(Client) then
Client.Free;
inherited;
end;

procedure TMyThread.Execute;
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
while Not Terminated do
begin
if Client.Connected then
begin
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
Progress := Rec.Flag;
// Synchronize(SetProgress);
FQueue.PushItem(Rec);
end
else
Client.Connect;
TThread.Sleep(10);
end;
end;


end.









share|improve this question















Good afternoon.



The client sends a message to the server, and the server responds by sending two messages to the client.



The client sees these messages, but the memo records the very first value sent by the server.



Prompt in what the reason



Server ----------------------------------------------------



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IDGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
MainPort := TIdTCPServer.Create;
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;
MainPort.Bindings.Add.IP := '127.0.0.1';
MainPort.Bindings.Add.Port := 6000;
MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;

type
TRec_Data = record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
Progress: string;
Client : TIdTCPClient;
FQueue : TThreadedQueue<TRec_Data>;
protected
procedure Execute; override;
public
constructor Create(const AQueue : TThreadedQueue<TRec_Data>);
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TThreadedQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue:=TThreadedQueue<TRec_Data>.Create(100, 1000, 10);

Timer:=TTimer.Create(Self);
Timer.Interval:=100;
Timer.OnTimer:=OnTimer;
Timer.Enabled:=True;

FMyThread:=TMyThread.Create(FQueue);
FMyThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free
end;
if Assigned(Timer) then
Timer.Free;
if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
Var ARec : TRec_Data;
begin
// while FQueue.PopItem(ARec) = TWaitResult.wrSignaled do или
if FQueue.PopItem(ARec) = TWaitResult.wrSignaled then
Form1.Memo1.Lines.Insert(0, ARec.Flag);
end;

constructor TMyThread.Create(const AQueue : TThreadedQueue<TRec_Data>);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
inherited Create(true);

FQueue:=AQueue;

Client := TIdTCPClient.Create(nil);
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.Connect;

// Передаем данные
if Client.Connected = True then
begin
Rec.Flag := 'addUser';

Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);
end;
end;

destructor TMyThread.Destroy;
begin
if Assigned(Client) then
Client.Free;
inherited;
end;

procedure TMyThread.Execute;
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
while Not Terminated do
begin
if Client.Connected then
begin
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
Progress := Rec.Flag;
// Synchronize(SetProgress);
FQueue.PushItem(Rec);
end
else
Client.Connect;
TThread.Sleep(10);
end;
end;


end.






delphi tcp firemonkey indy






share|improve this question















share|improve this question













share|improve this question




share|improve this question








edited Nov 23 '18 at 8:03







rustam

















asked Nov 23 '18 at 7:50









rustamrustam

32




32








  • 1




    Sorry, what exactly is your question?
    – Sherlock70
    Nov 23 '18 at 10:27














  • 1




    Sorry, what exactly is your question?
    – Sherlock70
    Nov 23 '18 at 10:27








1




1




Sorry, what exactly is your question?
– Sherlock70
Nov 23 '18 at 10:27




Sorry, what exactly is your question?
– Sherlock70
Nov 23 '18 at 10:27












1 Answer
1






active

oldest

votes


















3














On the server side, your are ignoring the client's request, and flooding the connection with endless responses. The TIdTCPServer.OnExecute event is called in a continuous loop for the lifetime of the connection, not when the client sends a request.



On the client side, you are running a continuous reading loop in a thread, trying to take in all of those responses. But your use of TThread.Sleep() ensures that loop reads messages much slower than the server can produce them, congesting network traffic.



But worse, you are hindering your client's ability to process server messages. Your UI timer runs at 100ms intervals, while the reading thread runs at 10ms intervals. So at most, 10 messages may be pushed into the queue per timer interval. Your OnTimer event handler pops only 1 message per interval, leaving up to 9 messages in the queue. So very quickly (~1s), the queue will fill up to its max capacity of 100 messages, and PushItem() will start ignoring messages. You are not checking for push errors/timeouts at all.



In addition, I see other issues with your code.



On the server side, you are leaking your TIdTCPServer object, as you don't assign an Owner to it, and you don't Free it. But also, your Form's OnCreate event handler is adding 2 separate bindings to TIdTCPServer - one on 127.0.0.1:0 and the other on 0.0.0.0:6000. It should be adding only one binding - on 127.0.0.1:6000.



On the client side, when creating your thread, you should not be calling TIdTCPClient.Connect() or TIdIOHandler.Write() in the thread's constructor, they belong in the thread's Execute() method only.



And lastly, I would suggest using TQueue<TRec_Data> instead of TThreadedQueue<TRec_Data>. The latter uses its own internal threads to manage push/pop timeouts, which is wasted overhead in this situation. You can use TMonitor or TEvent to accomplish the same thing without the extra threads.



With that said, try something more like this instead:



Server:



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = packed record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
Binding: TIdSocketHandle;
begin
MainPort := TIdTCPServer.Create(Self);
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;

// and a single listening socket for 127.0.0.1:6000
Binding := MainPort.Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 6000;

MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//...
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
// check if the client has sent any messages waiting to be read...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(0);
AContext.Connection.IOHandler.CheckForDisconnect;
end;

if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
// read a pending client message and process it as needed...
AContext.Connection.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
//...
end;

// send messages to the client...

Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);
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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
System.SyncObjs;

type
TRec_Data = packet record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
FQueue : TQueue<TRec_Data>;
FTermEvent : TEvent;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(const AQueue : TQueue<TRec_Data>); reintroduce;
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue := TQueue<TRec_Data>.Create;

Timer := TTimer.Create(Self);
Timer.Interval := 100;
Timer.OnTimer := OnTimer;
Timer.Enabled := True;

FMyThread := TMyThread.Create(FQueue);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free;
end;

if Assigned(Timer) then
Timer.Free;

if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
var
ARec : TRec_Data;
begin
// wait up to 10ms for the queue to be accessible...
if not TMonitor.Enter(FQueue, 10) then Exit;
try
// process all pending messages and remove them from the queue...
while FQueue.Count > 0 do
begin
ARec := FQueue.Dequeue;
Memo1.Lines.Insert(0, ARec.Flag);
end;
finally
TMonitor.Exit(FQueue);
end;
end;

constructor TMyThread.Create(const AQueue : TQueue<TRec_Data>);
begin
inherited Create(false);
FQueue := AQueue;

// used to signal Execute() to exit immediately while waiting
// to call Connect() after a failed connection...
FTermEvent := TEvent.Create(nil, true, false, '');
end;

procedure TMyThread.Destroy;
begin
FTermEvent.Free;
inherited;
end;

procedure TMyThread.TerminatedSet;
begin
// Terminate() was called, signal Execute() now...
FTermEvent.SetEvent;
end;

procedure TMyThread.Execute;
var
Client: TIdTCPClient;
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Client := TIdTCPClient.Create(nil);
try
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.ConnectTimeout := 5000;
Client.ReadTimeout := 5000;

while not Terminated do
begin
// try to connect to the server...
try
Client.Connect;
except
// wait 5 secs to try again...
FTermEvent.WaitFor(5000);
Continue;
end;

// connected...

try
try
Rec.Flag := 'addUser';
Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);

// communicate with the server until disconnected or terminating...
while not Terminated do
begin
// send other messages to the server as needed...

// check if the server has sent any messages waiting to be read.
// don't block the thread unless there is a message to read...
if Client.IOHandler.InputBufferIsEmpty then
begin
Client.IOHandler.CheckForDataOnSource(100);
Client.IOHandler.CheckForDisconnect;
if Client.IOHandler.InputBufferIsEmpty then Continue;
end;

// read a message...
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));

// wait up to 1 sec for the queue to be accessible...
if not TMonitor.Enter(FQueue, 1000) then
begin
// can't add message to queue yet, do something ...
end else
begin
// add message to queue...
try
FQueue.Enqueue(Rec);
finally
TMonitor.Exit(FQueue);
end;
end;
end;
finally
Client.Disconnect;
end;
except
// something unexpected happened, will reconnect and
// try again if not terminated...
end;
end;
finally
Client.Free;
end;
end;

end.





share|improve this answer























  • thank you very much, I will try
    – rustam
    Nov 23 '18 at 11:33










  • please help me somebody
    – rustam
    Nov 23 '18 at 17:56










  • @rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
    – Remy Lebeau
    Nov 23 '18 at 18:13












  • I added your code, but the client performs an infinite loop, accepts data from the server without stopping
    – rustam
    Nov 23 '18 at 18:16










  • if I add the exit, it sends two times the same value transmitted by the client
    – rustam
    Nov 23 '18 at 18:19













Your Answer






StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");

StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);

StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});

function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});


}
});














draft saved

draft discarded


















StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53442589%2ffiremonkey-idtcp-and-record%23new-answer', 'question_page');
}
);

Post as a guest















Required, but never shown

























1 Answer
1






active

oldest

votes








1 Answer
1






active

oldest

votes









active

oldest

votes






active

oldest

votes









3














On the server side, your are ignoring the client's request, and flooding the connection with endless responses. The TIdTCPServer.OnExecute event is called in a continuous loop for the lifetime of the connection, not when the client sends a request.



On the client side, you are running a continuous reading loop in a thread, trying to take in all of those responses. But your use of TThread.Sleep() ensures that loop reads messages much slower than the server can produce them, congesting network traffic.



But worse, you are hindering your client's ability to process server messages. Your UI timer runs at 100ms intervals, while the reading thread runs at 10ms intervals. So at most, 10 messages may be pushed into the queue per timer interval. Your OnTimer event handler pops only 1 message per interval, leaving up to 9 messages in the queue. So very quickly (~1s), the queue will fill up to its max capacity of 100 messages, and PushItem() will start ignoring messages. You are not checking for push errors/timeouts at all.



In addition, I see other issues with your code.



On the server side, you are leaking your TIdTCPServer object, as you don't assign an Owner to it, and you don't Free it. But also, your Form's OnCreate event handler is adding 2 separate bindings to TIdTCPServer - one on 127.0.0.1:0 and the other on 0.0.0.0:6000. It should be adding only one binding - on 127.0.0.1:6000.



On the client side, when creating your thread, you should not be calling TIdTCPClient.Connect() or TIdIOHandler.Write() in the thread's constructor, they belong in the thread's Execute() method only.



And lastly, I would suggest using TQueue<TRec_Data> instead of TThreadedQueue<TRec_Data>. The latter uses its own internal threads to manage push/pop timeouts, which is wasted overhead in this situation. You can use TMonitor or TEvent to accomplish the same thing without the extra threads.



With that said, try something more like this instead:



Server:



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = packed record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
Binding: TIdSocketHandle;
begin
MainPort := TIdTCPServer.Create(Self);
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;

// and a single listening socket for 127.0.0.1:6000
Binding := MainPort.Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 6000;

MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//...
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
// check if the client has sent any messages waiting to be read...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(0);
AContext.Connection.IOHandler.CheckForDisconnect;
end;

if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
// read a pending client message and process it as needed...
AContext.Connection.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
//...
end;

// send messages to the client...

Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);
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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
System.SyncObjs;

type
TRec_Data = packet record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
FQueue : TQueue<TRec_Data>;
FTermEvent : TEvent;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(const AQueue : TQueue<TRec_Data>); reintroduce;
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue := TQueue<TRec_Data>.Create;

Timer := TTimer.Create(Self);
Timer.Interval := 100;
Timer.OnTimer := OnTimer;
Timer.Enabled := True;

FMyThread := TMyThread.Create(FQueue);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free;
end;

if Assigned(Timer) then
Timer.Free;

if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
var
ARec : TRec_Data;
begin
// wait up to 10ms for the queue to be accessible...
if not TMonitor.Enter(FQueue, 10) then Exit;
try
// process all pending messages and remove them from the queue...
while FQueue.Count > 0 do
begin
ARec := FQueue.Dequeue;
Memo1.Lines.Insert(0, ARec.Flag);
end;
finally
TMonitor.Exit(FQueue);
end;
end;

constructor TMyThread.Create(const AQueue : TQueue<TRec_Data>);
begin
inherited Create(false);
FQueue := AQueue;

// used to signal Execute() to exit immediately while waiting
// to call Connect() after a failed connection...
FTermEvent := TEvent.Create(nil, true, false, '');
end;

procedure TMyThread.Destroy;
begin
FTermEvent.Free;
inherited;
end;

procedure TMyThread.TerminatedSet;
begin
// Terminate() was called, signal Execute() now...
FTermEvent.SetEvent;
end;

procedure TMyThread.Execute;
var
Client: TIdTCPClient;
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Client := TIdTCPClient.Create(nil);
try
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.ConnectTimeout := 5000;
Client.ReadTimeout := 5000;

while not Terminated do
begin
// try to connect to the server...
try
Client.Connect;
except
// wait 5 secs to try again...
FTermEvent.WaitFor(5000);
Continue;
end;

// connected...

try
try
Rec.Flag := 'addUser';
Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);

// communicate with the server until disconnected or terminating...
while not Terminated do
begin
// send other messages to the server as needed...

// check if the server has sent any messages waiting to be read.
// don't block the thread unless there is a message to read...
if Client.IOHandler.InputBufferIsEmpty then
begin
Client.IOHandler.CheckForDataOnSource(100);
Client.IOHandler.CheckForDisconnect;
if Client.IOHandler.InputBufferIsEmpty then Continue;
end;

// read a message...
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));

// wait up to 1 sec for the queue to be accessible...
if not TMonitor.Enter(FQueue, 1000) then
begin
// can't add message to queue yet, do something ...
end else
begin
// add message to queue...
try
FQueue.Enqueue(Rec);
finally
TMonitor.Exit(FQueue);
end;
end;
end;
finally
Client.Disconnect;
end;
except
// something unexpected happened, will reconnect and
// try again if not terminated...
end;
end;
finally
Client.Free;
end;
end;

end.





share|improve this answer























  • thank you very much, I will try
    – rustam
    Nov 23 '18 at 11:33










  • please help me somebody
    – rustam
    Nov 23 '18 at 17:56










  • @rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
    – Remy Lebeau
    Nov 23 '18 at 18:13












  • I added your code, but the client performs an infinite loop, accepts data from the server without stopping
    – rustam
    Nov 23 '18 at 18:16










  • if I add the exit, it sends two times the same value transmitted by the client
    – rustam
    Nov 23 '18 at 18:19


















3














On the server side, your are ignoring the client's request, and flooding the connection with endless responses. The TIdTCPServer.OnExecute event is called in a continuous loop for the lifetime of the connection, not when the client sends a request.



On the client side, you are running a continuous reading loop in a thread, trying to take in all of those responses. But your use of TThread.Sleep() ensures that loop reads messages much slower than the server can produce them, congesting network traffic.



But worse, you are hindering your client's ability to process server messages. Your UI timer runs at 100ms intervals, while the reading thread runs at 10ms intervals. So at most, 10 messages may be pushed into the queue per timer interval. Your OnTimer event handler pops only 1 message per interval, leaving up to 9 messages in the queue. So very quickly (~1s), the queue will fill up to its max capacity of 100 messages, and PushItem() will start ignoring messages. You are not checking for push errors/timeouts at all.



In addition, I see other issues with your code.



On the server side, you are leaking your TIdTCPServer object, as you don't assign an Owner to it, and you don't Free it. But also, your Form's OnCreate event handler is adding 2 separate bindings to TIdTCPServer - one on 127.0.0.1:0 and the other on 0.0.0.0:6000. It should be adding only one binding - on 127.0.0.1:6000.



On the client side, when creating your thread, you should not be calling TIdTCPClient.Connect() or TIdIOHandler.Write() in the thread's constructor, they belong in the thread's Execute() method only.



And lastly, I would suggest using TQueue<TRec_Data> instead of TThreadedQueue<TRec_Data>. The latter uses its own internal threads to manage push/pop timeouts, which is wasted overhead in this situation. You can use TMonitor or TEvent to accomplish the same thing without the extra threads.



With that said, try something more like this instead:



Server:



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = packed record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
Binding: TIdSocketHandle;
begin
MainPort := TIdTCPServer.Create(Self);
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;

// and a single listening socket for 127.0.0.1:6000
Binding := MainPort.Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 6000;

MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//...
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
// check if the client has sent any messages waiting to be read...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(0);
AContext.Connection.IOHandler.CheckForDisconnect;
end;

if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
// read a pending client message and process it as needed...
AContext.Connection.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
//...
end;

// send messages to the client...

Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);
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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
System.SyncObjs;

type
TRec_Data = packet record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
FQueue : TQueue<TRec_Data>;
FTermEvent : TEvent;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(const AQueue : TQueue<TRec_Data>); reintroduce;
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue := TQueue<TRec_Data>.Create;

Timer := TTimer.Create(Self);
Timer.Interval := 100;
Timer.OnTimer := OnTimer;
Timer.Enabled := True;

FMyThread := TMyThread.Create(FQueue);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free;
end;

if Assigned(Timer) then
Timer.Free;

if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
var
ARec : TRec_Data;
begin
// wait up to 10ms for the queue to be accessible...
if not TMonitor.Enter(FQueue, 10) then Exit;
try
// process all pending messages and remove them from the queue...
while FQueue.Count > 0 do
begin
ARec := FQueue.Dequeue;
Memo1.Lines.Insert(0, ARec.Flag);
end;
finally
TMonitor.Exit(FQueue);
end;
end;

constructor TMyThread.Create(const AQueue : TQueue<TRec_Data>);
begin
inherited Create(false);
FQueue := AQueue;

// used to signal Execute() to exit immediately while waiting
// to call Connect() after a failed connection...
FTermEvent := TEvent.Create(nil, true, false, '');
end;

procedure TMyThread.Destroy;
begin
FTermEvent.Free;
inherited;
end;

procedure TMyThread.TerminatedSet;
begin
// Terminate() was called, signal Execute() now...
FTermEvent.SetEvent;
end;

procedure TMyThread.Execute;
var
Client: TIdTCPClient;
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Client := TIdTCPClient.Create(nil);
try
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.ConnectTimeout := 5000;
Client.ReadTimeout := 5000;

while not Terminated do
begin
// try to connect to the server...
try
Client.Connect;
except
// wait 5 secs to try again...
FTermEvent.WaitFor(5000);
Continue;
end;

// connected...

try
try
Rec.Flag := 'addUser';
Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);

// communicate with the server until disconnected or terminating...
while not Terminated do
begin
// send other messages to the server as needed...

// check if the server has sent any messages waiting to be read.
// don't block the thread unless there is a message to read...
if Client.IOHandler.InputBufferIsEmpty then
begin
Client.IOHandler.CheckForDataOnSource(100);
Client.IOHandler.CheckForDisconnect;
if Client.IOHandler.InputBufferIsEmpty then Continue;
end;

// read a message...
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));

// wait up to 1 sec for the queue to be accessible...
if not TMonitor.Enter(FQueue, 1000) then
begin
// can't add message to queue yet, do something ...
end else
begin
// add message to queue...
try
FQueue.Enqueue(Rec);
finally
TMonitor.Exit(FQueue);
end;
end;
end;
finally
Client.Disconnect;
end;
except
// something unexpected happened, will reconnect and
// try again if not terminated...
end;
end;
finally
Client.Free;
end;
end;

end.





share|improve this answer























  • thank you very much, I will try
    – rustam
    Nov 23 '18 at 11:33










  • please help me somebody
    – rustam
    Nov 23 '18 at 17:56










  • @rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
    – Remy Lebeau
    Nov 23 '18 at 18:13












  • I added your code, but the client performs an infinite loop, accepts data from the server without stopping
    – rustam
    Nov 23 '18 at 18:16










  • if I add the exit, it sends two times the same value transmitted by the client
    – rustam
    Nov 23 '18 at 18:19
















3












3








3






On the server side, your are ignoring the client's request, and flooding the connection with endless responses. The TIdTCPServer.OnExecute event is called in a continuous loop for the lifetime of the connection, not when the client sends a request.



On the client side, you are running a continuous reading loop in a thread, trying to take in all of those responses. But your use of TThread.Sleep() ensures that loop reads messages much slower than the server can produce them, congesting network traffic.



But worse, you are hindering your client's ability to process server messages. Your UI timer runs at 100ms intervals, while the reading thread runs at 10ms intervals. So at most, 10 messages may be pushed into the queue per timer interval. Your OnTimer event handler pops only 1 message per interval, leaving up to 9 messages in the queue. So very quickly (~1s), the queue will fill up to its max capacity of 100 messages, and PushItem() will start ignoring messages. You are not checking for push errors/timeouts at all.



In addition, I see other issues with your code.



On the server side, you are leaking your TIdTCPServer object, as you don't assign an Owner to it, and you don't Free it. But also, your Form's OnCreate event handler is adding 2 separate bindings to TIdTCPServer - one on 127.0.0.1:0 and the other on 0.0.0.0:6000. It should be adding only one binding - on 127.0.0.1:6000.



On the client side, when creating your thread, you should not be calling TIdTCPClient.Connect() or TIdIOHandler.Write() in the thread's constructor, they belong in the thread's Execute() method only.



And lastly, I would suggest using TQueue<TRec_Data> instead of TThreadedQueue<TRec_Data>. The latter uses its own internal threads to manage push/pop timeouts, which is wasted overhead in this situation. You can use TMonitor or TEvent to accomplish the same thing without the extra threads.



With that said, try something more like this instead:



Server:



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = packed record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
Binding: TIdSocketHandle;
begin
MainPort := TIdTCPServer.Create(Self);
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;

// and a single listening socket for 127.0.0.1:6000
Binding := MainPort.Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 6000;

MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//...
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
// check if the client has sent any messages waiting to be read...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(0);
AContext.Connection.IOHandler.CheckForDisconnect;
end;

if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
// read a pending client message and process it as needed...
AContext.Connection.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
//...
end;

// send messages to the client...

Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);
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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
System.SyncObjs;

type
TRec_Data = packet record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
FQueue : TQueue<TRec_Data>;
FTermEvent : TEvent;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(const AQueue : TQueue<TRec_Data>); reintroduce;
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue := TQueue<TRec_Data>.Create;

Timer := TTimer.Create(Self);
Timer.Interval := 100;
Timer.OnTimer := OnTimer;
Timer.Enabled := True;

FMyThread := TMyThread.Create(FQueue);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free;
end;

if Assigned(Timer) then
Timer.Free;

if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
var
ARec : TRec_Data;
begin
// wait up to 10ms for the queue to be accessible...
if not TMonitor.Enter(FQueue, 10) then Exit;
try
// process all pending messages and remove them from the queue...
while FQueue.Count > 0 do
begin
ARec := FQueue.Dequeue;
Memo1.Lines.Insert(0, ARec.Flag);
end;
finally
TMonitor.Exit(FQueue);
end;
end;

constructor TMyThread.Create(const AQueue : TQueue<TRec_Data>);
begin
inherited Create(false);
FQueue := AQueue;

// used to signal Execute() to exit immediately while waiting
// to call Connect() after a failed connection...
FTermEvent := TEvent.Create(nil, true, false, '');
end;

procedure TMyThread.Destroy;
begin
FTermEvent.Free;
inherited;
end;

procedure TMyThread.TerminatedSet;
begin
// Terminate() was called, signal Execute() now...
FTermEvent.SetEvent;
end;

procedure TMyThread.Execute;
var
Client: TIdTCPClient;
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Client := TIdTCPClient.Create(nil);
try
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.ConnectTimeout := 5000;
Client.ReadTimeout := 5000;

while not Terminated do
begin
// try to connect to the server...
try
Client.Connect;
except
// wait 5 secs to try again...
FTermEvent.WaitFor(5000);
Continue;
end;

// connected...

try
try
Rec.Flag := 'addUser';
Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);

// communicate with the server until disconnected or terminating...
while not Terminated do
begin
// send other messages to the server as needed...

// check if the server has sent any messages waiting to be read.
// don't block the thread unless there is a message to read...
if Client.IOHandler.InputBufferIsEmpty then
begin
Client.IOHandler.CheckForDataOnSource(100);
Client.IOHandler.CheckForDisconnect;
if Client.IOHandler.InputBufferIsEmpty then Continue;
end;

// read a message...
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));

// wait up to 1 sec for the queue to be accessible...
if not TMonitor.Enter(FQueue, 1000) then
begin
// can't add message to queue yet, do something ...
end else
begin
// add message to queue...
try
FQueue.Enqueue(Rec);
finally
TMonitor.Exit(FQueue);
end;
end;
end;
finally
Client.Disconnect;
end;
except
// something unexpected happened, will reconnect and
// try again if not terminated...
end;
end;
finally
Client.Free;
end;
end;

end.





share|improve this answer














On the server side, your are ignoring the client's request, and flooding the connection with endless responses. The TIdTCPServer.OnExecute event is called in a continuous loop for the lifetime of the connection, not when the client sends a request.



On the client side, you are running a continuous reading loop in a thread, trying to take in all of those responses. But your use of TThread.Sleep() ensures that loop reads messages much slower than the server can produce them, congesting network traffic.



But worse, you are hindering your client's ability to process server messages. Your UI timer runs at 100ms intervals, while the reading thread runs at 10ms intervals. So at most, 10 messages may be pushed into the queue per timer interval. Your OnTimer event handler pops only 1 message per interval, leaving up to 9 messages in the queue. So very quickly (~1s), the queue will fill up to its max capacity of 100 messages, and PushItem() will start ignoring messages. You are not checking for push errors/timeouts at all.



In addition, I see other issues with your code.



On the server side, you are leaking your TIdTCPServer object, as you don't assign an Owner to it, and you don't Free it. But also, your Form's OnCreate event handler is adding 2 separate bindings to TIdTCPServer - one on 127.0.0.1:0 and the other on 0.0.0.0:6000. It should be adding only one binding - on 127.0.0.1:6000.



On the client side, when creating your thread, you should not be calling TIdTCPClient.Connect() or TIdIOHandler.Write() in the thread's constructor, they belong in the thread's Execute() method only.



And lastly, I would suggest using TQueue<TRec_Data> instead of TThreadedQueue<TRec_Data>. The latter uses its own internal threads to manage push/pop timeouts, which is wasted overhead in this situation. You can use TMonitor or TEvent to accomplish the same thing without the extra threads.



With that said, try something more like this instead:



Server:



unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, IdGlobal,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
FMX.Controls.Presentation, FMX.StdCtrls;

type
TRec_Data = packed record
Flag: array[0..20] of char;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
MainPort: TIdTCPServer;
procedure MainPortConnect(AContext: TIdContext);
procedure MainPortExecute(AContext: TIdContext);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
Binding: TIdSocketHandle;
begin
MainPort := TIdTCPServer.Create(Self);
MainPort.OnConnect := MainPortConnect;
MainPort.OnExecute := MainPortExecute;

// and a single listening socket for 127.0.0.1:6000
Binding := MainPort.Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 6000;

MainPort.Active := True;
end;

procedure TForm1.MainPortConnect(AContext: TIdContext);
begin
//...
end;

procedure TForm1.MainPortExecute(AContext: TIdContext);
var
Rec: TRec_Data;
Buffer: TIdBytes;
begin
// check if the client has sent any messages waiting to be read...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(0);
AContext.Connection.IOHandler.CheckForDisconnect;
end;

if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
// read a pending client message and process it as needed...
AContext.Connection.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));
//...
end;

// send messages to the client...

Rec.Flag := '1';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);

Rec.Flag := '2';
Buffer := RawToBytes(Rec, SizeOf(Rec));
AContext.Connection.IOHandler.Write(Buffer);
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,
System.Generics.Collections,
IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
System.SyncObjs;

type
TRec_Data = packet record
Flag: array[0..20] of char;
end;

TMyThread = class(TThread)
private
FQueue : TQueue<TRec_Data>;
FTermEvent : TEvent;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(const AQueue : TQueue<TRec_Data>); reintroduce;
destructor Destroy; override;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FQueue : TQueue<TRec_Data>;
FMyThread : TMyThread;
Timer : TTimer;
procedure OnTimer(Sender: TObject);
public
Memo1: TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
FQueue := TQueue<TRec_Data>.Create;

Timer := TTimer.Create(Self);
Timer.Interval := 100;
Timer.OnTimer := OnTimer;
Timer.Enabled := True;

FMyThread := TMyThread.Create(FQueue);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FMyThread) then
begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free;
end;

if Assigned(Timer) then
Timer.Free;

if Assigned(FQueue) then
FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
var
ARec : TRec_Data;
begin
// wait up to 10ms for the queue to be accessible...
if not TMonitor.Enter(FQueue, 10) then Exit;
try
// process all pending messages and remove them from the queue...
while FQueue.Count > 0 do
begin
ARec := FQueue.Dequeue;
Memo1.Lines.Insert(0, ARec.Flag);
end;
finally
TMonitor.Exit(FQueue);
end;
end;

constructor TMyThread.Create(const AQueue : TQueue<TRec_Data>);
begin
inherited Create(false);
FQueue := AQueue;

// used to signal Execute() to exit immediately while waiting
// to call Connect() after a failed connection...
FTermEvent := TEvent.Create(nil, true, false, '');
end;

procedure TMyThread.Destroy;
begin
FTermEvent.Free;
inherited;
end;

procedure TMyThread.TerminatedSet;
begin
// Terminate() was called, signal Execute() now...
FTermEvent.SetEvent;
end;

procedure TMyThread.Execute;
var
Client: TIdTCPClient;
Rec: TRec_Data;
Buffer: TIdBytes;
begin
Client := TIdTCPClient.Create(nil);
try
Client.Host := '127.0.0.1';
Client.Port := 6000;
Client.ConnectTimeout := 5000;
Client.ReadTimeout := 5000;

while not Terminated do
begin
// try to connect to the server...
try
Client.Connect;
except
// wait 5 secs to try again...
FTermEvent.WaitFor(5000);
Continue;
end;

// connected...

try
try
Rec.Flag := 'addUser';
Buffer := RawToBytes(Rec, SizeOf(Rec));
Client.IOHandler.Write(Buffer);

// communicate with the server until disconnected or terminating...
while not Terminated do
begin
// send other messages to the server as needed...

// check if the server has sent any messages waiting to be read.
// don't block the thread unless there is a message to read...
if Client.IOHandler.InputBufferIsEmpty then
begin
Client.IOHandler.CheckForDataOnSource(100);
Client.IOHandler.CheckForDisconnect;
if Client.IOHandler.InputBufferIsEmpty then Continue;
end;

// read a message...
Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
BytesToRaw(Buffer, Rec, SizeOf(Rec));

// wait up to 1 sec for the queue to be accessible...
if not TMonitor.Enter(FQueue, 1000) then
begin
// can't add message to queue yet, do something ...
end else
begin
// add message to queue...
try
FQueue.Enqueue(Rec);
finally
TMonitor.Exit(FQueue);
end;
end;
end;
finally
Client.Disconnect;
end;
except
// something unexpected happened, will reconnect and
// try again if not terminated...
end;
end;
finally
Client.Free;
end;
end;

end.






share|improve this answer














share|improve this answer



share|improve this answer








edited Nov 25 '18 at 18:38

























answered Nov 23 '18 at 10:30









Remy LebeauRemy Lebeau

331k18251443




331k18251443












  • thank you very much, I will try
    – rustam
    Nov 23 '18 at 11:33










  • please help me somebody
    – rustam
    Nov 23 '18 at 17:56










  • @rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
    – Remy Lebeau
    Nov 23 '18 at 18:13












  • I added your code, but the client performs an infinite loop, accepts data from the server without stopping
    – rustam
    Nov 23 '18 at 18:16










  • if I add the exit, it sends two times the same value transmitted by the client
    – rustam
    Nov 23 '18 at 18:19




















  • thank you very much, I will try
    – rustam
    Nov 23 '18 at 11:33










  • please help me somebody
    – rustam
    Nov 23 '18 at 17:56










  • @rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
    – Remy Lebeau
    Nov 23 '18 at 18:13












  • I added your code, but the client performs an infinite loop, accepts data from the server without stopping
    – rustam
    Nov 23 '18 at 18:16










  • if I add the exit, it sends two times the same value transmitted by the client
    – rustam
    Nov 23 '18 at 18:19


















thank you very much, I will try
– rustam
Nov 23 '18 at 11:33




thank you very much, I will try
– rustam
Nov 23 '18 at 11:33












please help me somebody
– rustam
Nov 23 '18 at 17:56




please help me somebody
– rustam
Nov 23 '18 at 17:56












@rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
– Remy Lebeau
Nov 23 '18 at 18:13






@rustam "does not work" - in what way exactly? You need to be more specific. "I did not say that this is a firemonkey project" - yes, you did. Your question is tagged firemonkey and the code you posted uses FireMonkey units. "please help me somebody" - I did.
– Remy Lebeau
Nov 23 '18 at 18:13














I added your code, but the client performs an infinite loop, accepts data from the server without stopping
– rustam
Nov 23 '18 at 18:16




I added your code, but the client performs an infinite loop, accepts data from the server without stopping
– rustam
Nov 23 '18 at 18:16












if I add the exit, it sends two times the same value transmitted by the client
– rustam
Nov 23 '18 at 18:19






if I add the exit, it sends two times the same value transmitted by the client
– rustam
Nov 23 '18 at 18:19




















draft saved

draft discarded




















































Thanks for contributing an answer to Stack Overflow!


  • Please be sure to answer the question. Provide details and share your research!

But avoid



  • Asking for help, clarification, or responding to other answers.

  • Making statements based on opinion; back them up with references or personal experience.


To learn more, see our tips on writing great answers.





Some of your past answers have not been well-received, and you're in danger of being blocked from answering.


Please pay close attention to the following guidance:


  • Please be sure to answer the question. Provide details and share your research!

But avoid



  • Asking for help, clarification, or responding to other answers.

  • Making statements based on opinion; back them up with references or personal experience.


To learn more, see our tips on writing great answers.




draft saved


draft discarded














StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53442589%2ffiremonkey-idtcp-and-record%23new-answer', 'question_page');
}
);

Post as a guest















Required, but never shown





















































Required, but never shown














Required, but never shown












Required, but never shown







Required, but never shown

































Required, but never shown














Required, but never shown












Required, but never shown







Required, but never shown







Popular posts from this blog

Berounka

Sphinx de Gizeh

Different font size/position of beamer's navigation symbols template's content depending on regular/plain...