Nsryjdtyk

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.

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.