На стороне сервера вы игнорируете запрос клиента и загружаете соединение бесконечными ответами.Событие TIdTCPServer.OnExecute вызывается в непрерывном цикле в течение всего времени жизни соединения, а не когда клиент отправляет запрос.
На стороне клиента вы выполняете непрерывный цикл чтения в потоке, пытаясьпринять во всех этих ответах.Но использование TThread.Sleep() гарантирует, что циклическое чтение сообщений будет намного медленнее, чем сервер может их генерировать, что приводит к перегрузке сетевого трафика.
Но, что еще хуже, вы мешаете клиенту обрабатывать серверные сообщения.Ваш таймер пользовательского интерфейса работает с интервалами 100 мс, а поток чтения - с интервалами 10 мс.Таким образом, самое большее, 10 сообщений могут быть помещены в очередь за интервал таймера.Ваш обработчик событий OnTimer выводит только 1 сообщение за интервал, оставляя в очереди до 9 сообщений.Таким образом, очень быстро (~ 1 с) очередь заполняется до максимальной вместимости 100 сообщений, и PushItem() начнет игнорировать сообщения.Вы вообще не проверяете наличие ошибок push / timeout.
Кроме того, я вижу другие проблемы с вашим кодом.
На стороне сервера вы пропускаете свой объект TIdTCPServer, поскольку вы не присваиваете ему Owner и не Free.Кроме того, обработчик событий OnCreate вашей формы добавляет 2 отдельные привязки к TIdTCPServer - одну на 127.0.0.1:0, а другую на 0.0.0.0:6000.Следует добавить только одну привязку - на 127.0.0.1:6000.
На стороне клиента при создании потока не следует вызывать TIdTCPClient.Connect() или TIdIOHandler.Write() в конструкторе потока, они принадлежаттолько для Execute() метода.
И, наконец, я бы предложил использовать TQueue<TRec_Data> вместо TThreadedQueue<TRec_Data>.Последний использует свои собственные внутренние потоки для управления тайм-аутами push / pop, которые в этой ситуации тратятся впустую.Вы можете использовать TMonitor или TEvent, чтобы выполнить то же самое без дополнительных потоков.
Сказав это, попробуйте что-то вроде этого:
Сервер:
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.
Клиент:
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.