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.
rustam
  • 21
  • 4

1 Answers1

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.
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
  • 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
  • if AContext.Connection.IOHandler.InputBufferIsEmpty then begin AContext.Connection.IOHandler.CheckForDataOnSource(0); AContext.Connection.IOHandler.CheckForDisconnect; exit; end; – rustam Nov 23 '18 at 18:20
  • this is project Firemonkey, – rustam Nov 23 '18 at 18:58
  • @rustam it is supposed to loop indefinitely, until the connection is closed. And the `Exit` you added is wrong, you need to get rid of it it is preventing the server from sending any data to the client at all – Remy Lebeau Nov 23 '18 at 19:08
  • Everything works, thank you. One more question, how to send by tcp from the form (for example, by pressing a button Rec.Flag: = 'addPass'). We created a TIdTCPClient in Execute, and now I cannot pass parameters from the form. I need to transfer data from the form every time, not to make a stream every time. and why my client form not close, FMyThread.WaitFor, FMyThread.Free - keeps the form from closing – rustam Nov 25 '18 at 18:31
  • @rustam You will have to add communication between the main thread and the worker thread. The button can post a message to the thread, then the thread can send the message to the server when appropriate. Otherwise, you will have to expose direct access to the client so the button can reach it. But that opens up a race condition allowing both threads to potentially write data to the server at the same time, so you have to make your threads coordinate with each other to avoid overlapping sends. That is why it is best to do all of the sends in a single thread only, whichever thread that is. – Remy Lebeau Nov 25 '18 at 18:36
  • @rustam as for the closing issue, if the thread is currently blocked on `ReadBytes()` when `WaitFor()` is called, it won't be able to detect the signal to terminate itself until after the next server message is received. I have updated my example to work around that. – Remy Lebeau Nov 25 '18 at 18:37