schnelle Server Client Verbindung ohne Verluste

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547867)

Zeitmessung 02 schlägt regelmäßig zu, 300ms ist normal (pro Aufruf), manchmal sogar länger.
Hast du eine Idee dazu?

Nagle in work !
it is 300ms (more like 1000/3=333ms) by default on Windows in most cases anyway, just disable it, as i recall there is property somewhere in Indy (can't recall handler or something) to disable, but if there is not, then use setsockopt for TCP_NODELAY
https://en.wikipedia.org/wiki/Nagle%27s_algorithm

[AJ_Oldendorf]

Ich habe im TIdClient und TIdServer jeweils die Property UseNagle auf False gesetzt.
Vor dem Write Aufruf, habe ich UseNagle nochmal abgefragt, ob es wirklich False ist. Ja es ist False.
Ich habe den Write-Aufruf testweise direkt auf WriteDirect geändert.
Trotzdem habe ich das Problem, dass die Write-Aufrufe zwischen 300ms und 1500ms dauern.
Die Daten, welche gesendet werden sollen, stehen in einer Liste und werden über eine While-Schleife abgearbeitet (also innerhalb der While Schleife findet der Write Aufruf statt). Es wird immer der erste Datensatz aus der Liste genommen und die While Schleife läuft bis Count = 0.
Die Telegramme sind zwischen 40 Byte und 25000 Byte lang.
Beispiel: Liste enthält 100 Einträge, es dauert pro Write-Aufruf ~300ms, also dauert die ganze While-Schleife 30s.

Noch eine Idee, mit dem Write-Aufruf?

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547886)

Ich habe im TIdClient und TIdServer jeweils die Property UseNagle auf False gesetzt.
Vor dem Write Aufruf, habe ich UseNagle nochmal abgefragt, ob es wirklich False ist. Ja es ist False.
Ich habe den Write-Aufruf testweise direkt auf WriteDirect geändert.
Trotzdem habe ich das Problem, dass die Write-Aufrufe zwischen 300ms und 1500ms dauern.
Die Daten, welche gesendet werden sollen, stehen in einer Liste und werden über eine While-Schleife abgearbeitet (also innerhalb der While Schleife findet der Write Aufruf statt). Es wird immer der erste Datensatz aus der Liste genommen und die While Schleife läuft bis Count = 0.
Die Telegramme sind zwischen 40 Byte und 25000 Byte lang.
Beispiel: Liste enthält 100 Einträge, es dauert pro Write-Aufruf ~300ms, also dauert die ganze While-Schleife 30s.

Noch eine Idee, mit dem Write-Aufruf?

I am sorry but the translation is hard to follow, by telegram you mean packets, right ? ...anyway

the Nagle should be disabled once per socket, Doesn't need to be adjusted before every call, also it is little more than just disable and forget, make sure both server and client are disabling it, the reason is it is affect packet sending and buffering for packets (buffer) less than MTU (around 1500 bytes) which include the ACK, this ACK will and might delay the traffic, so on both sides,
Nagle by RFC should be 200ms (yet on linux it is 50ms), but it is very hard to witness and measure this exact 200ms, it is possible on Wireshark though, but it is harder form coding on Windows because these modern Windows (definitely since v8) the selective ACK is enabled by default and these two play together, most the time it will be measured from you own code higher than 200ms and less than the double 400ms.

So the suggestion here is: Nagle is not the cause this delay in your program as it can't reach 1500ms, unless the connection is bad and so bad suffering from retransmission, you did not mention how and where you are testing, on loopback (same device) or over network (wireless or wired?) ....

In all cases, i prefer to see code and give it a try and find your bug, please provide a demo causing this.

[AJ_Oldendorf]

Yes, one telegram is one packet.

UseNagle is deactivated on Client and Server only one time (in object inspector property of component).
I only checked before I call "write", if UseNagle is really deactivated. Yes it is.

I test it with Delphi 12 in Host machine (=server) and virtual machine with Delphi 12 (=client).

I try to reduce my source code to a demo project but actual it isn't so easy because it is full implemented in our company software. I will try it...

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547889)

Yes, one telegram is one packet.

UseNagle is deactivated on Client and Server only one time (in object inspector property of component).
I only checked before I call "write", if UseNagle is really deactivated. Yes it is.

I test it with Delphi 12 in Host machine (=server) and virtual machine with Delphi 12 (=client).

I try to reduce my source code to a demo project but actual it isn't so easy because it is full implemented in our company software. I will try it...

Thank you for replaying, and i don't care about the data, just a code like other and older samples/demos in this thread, but something shows this behaviour of delay or higher CPU usage..etc.
Preferably without inline var as i don't have them.

[AJ_Oldendorf]

Hier ist eine Demo, womit sich das Verhalten fast 1:1 nachstellen lässt.
Ich habe die nur schnell zusammen geschustert 8-)

Vorgehensweise:
1)Server-Anwendung starten
2)Client-Anwendung starten
3)Client Button Klick -> Pakete senden
4)Server empfängt diese und zeigt es im Memo an
5)Server Button Klick -> Pakete werden nur 5 Stück geschickt (siehe Protokollierung Memo) und der Sendethread hängt irgendwo im Write-Aufruf da auf ein Breakpoint im while not Terminated nicht reagiert wird
6)Nochmal Daten vom Client senden über den Button Klick
7)Server verschickt die restlichen Telegramme (siehe Memo) und empfängt danach (da sieht man dann auch, dass der Write Aufruf mehrere Sekunden hing)

Hat jemand eine Idee dazu?

Client:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  System.SyncObjs, IdContext, IdGlobal, System.Generics.Collections,
  System.Diagnostics, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TDataQueue = class
  private
    FQueue: TQueue<TIdBytes>;
    FLock: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enqueue(const Data: TIdBytes);
    function Dequeue: TIdBytes;
  end;

  TProcessingThread = class(TThread)
  private
    FDataQueue: TDataQueue;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    constructor Create(ADataQueue: TDataQueue);
  end;

  TMyTCPClient = class
  private
    FParentServer : TIdTCPClient;
    FForm : TForm;
  public
    constructor Create(aForm : TForm);
    destructor Destroy; override;
    procedure Connect(const AHost: string; APort: Integer);
    procedure Disconnect;
    procedure SendData(const Data: TIdBytes);
  end;

  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdIOHandlerStack1: TIdIOHandlerStack;
    Memo1: TMemo;
    UpdateTimer: TTimer;
    Button1: TButton;
    procedure UpdateTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    MyClient: TMyTCPClient;
    SL : TStringList;
  public
    { Public-Deklarationen }
    procedure Log(aStr : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDataQueue }

constructor TDataQueue.Create;
begin
  FQueue := TQueue<TIdBytes>.Create;
  FLock := TCriticalSection.Create;
end;

destructor TDataQueue.Destroy;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

function TDataQueue.Dequeue: TIdBytes;
begin
  FLock.Acquire;
  try
    if FQueue.Count > 0 then
      Result := FQueue.Dequeue
    else
      SetLength(Result, 0);
  finally
    FLock.Release;
  end;
end;

procedure TDataQueue.Enqueue(const Data: TIdBytes);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
end;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  Anz := 0;
  inherited Create(False);
end;

procedure TProcessingThread.Execute;
var
  Data: TIdBytes;
begin
  while not Terminated do
  begin

  end;
end;

{ TMyTCPClient }

procedure TMyTCPClient.Connect(const AHost: string; APort: Integer);
begin
  FParentServer.Host := AHost;
  FParentServer.Port := APort;
  FParentServer.ConnectTimeout := 5000; // 5 Sekunden Timeout
  FParentServer.ReadTimeout := 5000; // 5 Sekunden Timeout für Lesevorgänge
  FParentServer.Connect;
  TForm1(FForm).Log('Verbunden mit ' + AHost + ':' + APort.ToString);
end;

constructor TMyTCPClient.Create(aForm : TForm);
begin
  FForm := aForm;

  FParentServer := TForm1(FForm).IdTCPClient1;
end;

destructor TMyTCPClient.Destroy;
begin
  Disconnect;
  inherited;
end;

procedure TMyTCPClient.Disconnect;
begin
  if FParentServer.Connected then
  begin
    FParentServer.Disconnect;
    TForm1(FForm).Log('Verbindung getrennt.');
  end;
end;

procedure TMyTCPClient.SendData(const Data: TIdBytes);
begin
  if FParentServer.Connected then
  begin
    FParentServer.IOHandler.WriteDirect(Data);
    //TForm1(FForm).Log(Now, ' Gesendet: ', Length(Data), ' Bytes');
  end
  else
  begin
    FParentServer.Connect;
    //TForm1(FForm).Log('Fehler: Nicht verbunden.');
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestData: TIdBytes;
  Anz : LongWord;
begin
  if not Assigned(MyClient) then
    Exit;

  var sw3 := TStopwatch.StartNew;
  var t3 : Int64;

  SetLength(TestData, 61000); //1024
  FillChar(TestData[0], Length(TestData), 65);

  Anz := 0;

  for var i := 1 to 200 do
  begin
    Inc(Anz, Length(TestData));

    MyClient.SendData(TestData);
  end;

  t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
  Log('Zeitdauer: ' + t3.ToString + ' ms');

  Log('Gesamtlänge: ' + Anz.ToString + ' Bytes');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SL := TStringList.Create;
  Memo1.Clear;

  try
    MyClient := TMyTCPClient.Create(Self);
    try
      MyClient.Connect('127.0.0.1', 5000);

      var sw3 := TStopwatch.StartNew;
      var t3 : Int64;
    finally

    end;
  except
    on E: Exception do
      Log('Fehler: ' + E.Message);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyClient.Disconnect;
  FreeAndNil(MyClient);
  FreeAndNil(SL);
end;

procedure TForm1.Log(aStr : String);
begin
  SL.Add(aStr);

  if UpdateTimer.Enabled then
    Exit;

  UpdateTimer.Enabled := True;
end;

procedure TForm1.UpdateTimerTimer(Sender: TObject);
begin
  UpdateTimer.Enabled := False;

  Memo1.Lines.Text := SL.Text;
end;

end.

Server:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  IdServerIOHandler, IdServerIOHandlerSocket, IdServerIOHandlerStack,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, System.SyncObjs,
  System.Generics.Collections, System.Diagnostics, IdGlobal, IdContext,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TMyTCPServer = class;

  TDataRec = record
    Daten : TIdBytes;
    Context : TIdContext;
  end;

  TReceiveEvent = procedure(Sender: TObject; aData : TDataRec) of Object;

  TDataQueue = class
  private
    FQueue: TQueue<TIdBytes>;
    FLock: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enqueue(const Data: TIdBytes);
    function Dequeue: TIdBytes;
  end;

  TProcessingThread = class(TThread)
  private
    FDataQueue: TDataQueue;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    OnReceive : TReceiveEvent;

    constructor Create(ADataQueue: TDataQueue);
  end;

  TSendeThread = class(TThread)
  private
    FDataQueue: TDataQueue;
    FParent : TMyTCPServer;
    PrtGes : Boolean;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    constructor Create(aParent : TMyTCPServer; ADataQueue: TDataQueue);
  end;

  TMyTCPServer = class
  private
    FDataQueue: TDataQueue;
    FSendeDataQueue : TDataQueue;
    FParentServer : TIdTCPServer;
    FForm : TForm;

    FProcessingThread: TProcessingThread;
    FSendeThread: TSendeThread;
    FLastContext : TIdContext;
    FAnzEmpfang : LongWord;
    FBytesEmpfang : LongWord;

    ReadingIsActiv : Boolean;

    procedure OnExecuteHandler(AContext: TIdContext);

    procedure OnServerReadData(Sender: TObject; aData : TDataRec);
  public
    constructor Create(aForm : TForm);
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  end;

  TForm1 = class(TForm)
    IdTCPServer: TIdTCPServer;
    IdServerIOHandlerStack: TIdServerIOHandlerStack;
    Memo1: TMemo;
    UpdateTimer: TTimer;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UpdateTimerTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    MyServer: TMyTCPServer;
    SL : TStringList;
  public
    { Public-Deklarationen }
    procedure Log(aStr : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDataQueue }

constructor TDataQueue.Create;
begin
  FQueue := TQueue<TIdBytes>.Create;
  FLock := TCriticalSection.Create;
end;

destructor TDataQueue.Destroy;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

function TDataQueue.Dequeue: TIdBytes;
begin
  FLock.Acquire;
  try
    if FQueue.Count > 0 then
      Result := FQueue.Dequeue
    else
      SetLength(Result, 0);
  finally
    FLock.Release;
  end;
end;

procedure TDataQueue.Enqueue(const Data: TIdBytes);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
end;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  Anz := 0;
  inherited Create(False);
end;

procedure TProcessingThread.Execute;
var
  Data: TIdBytes;
begin
  while not Terminated do
  begin
    Data := FDataQueue.Dequeue;
    if Length(Data) > 0 then
    begin
      Inc(Anz, Length(Data));

      //TForm1(FParent.FForm).Log('Empfangen: ', Length(Data), ' Bytes' + '- Anz: ' + Anz.ToString);
    end
    else
      Sleep(1);

    if (FDataQueue.FQueue.Count = 0) then
    begin
      //TForm1(FParent.FForm).Log('Gesamtlänge Empfang: ' + Anz.ToString + ' Bytes');
    end;
  end;
end;

{ TMyTCPServer }

constructor TMyTCPServer.Create(aForm : TForm);
begin
  FDataQueue := TDataQueue.Create;
  FSendeDataQueue := TDataQueue.Create;
  FLastContext := Nil;

  FProcessingThread := TProcessingThread.Create(FDataQueue);
  FProcessingThread.OnReceive := OnServerReadData;

  FSendeThread := TSendeThread.Create(Self, FSendeDataQueue);

  FForm := aForm;

  FParentServer := TForm1(FForm).IdTCPServer;
  FParentServer.DefaultPort := 5000;
  FParentServer.OnExecute := OnExecuteHandler;
end;

destructor TMyTCPServer.Destroy;
begin
  Stop;
  FreeAndNil(FSendeThread);
  FreeAndNil(FProcessingThread);
  FreeAndNil(FSendeDataQueue);
  FreeAndNil(FDataQueue);
  inherited;
end;

procedure TMyTCPServer.OnExecuteHandler(AContext: TIdContext);
var
  Buffer: TIdBytes;
begin
  FLastContext := AContext;
  if AContext.Connection.IOHandler.InputBuffer.Size > 0 then
  begin
    ReadingIsActiv := True;
    while AContext.Connection.IOHandler.InputBuffer.Size > 0 do
    begin
      Inc(FAnzEmpfang);
      Inc(FBytesEmpfang, AContext.Connection.IOHandler.InputBuffer.Size);

      SetLength(Buffer, AContext.Connection.IOHandler.InputBuffer.Size); //<- so viel einlesen wie im Buffer enthalten ist
      AContext.Connection.IOHandler.ReadBytes(Buffer, Length(Buffer), False);
      FDataQueue.Enqueue(Buffer);
    end;
    ReadingIsActiv := False;
  end
  else
  begin
    Sleep(1);

    if (FAnzEmpfang <> 0) or (FBytesEmpfang <> 0) then
    begin
      TForm1(FForm).Log('Receive-Anzahl: ' + FAnzEmpfang.ToString);
      TForm1(FForm).Log('Receive-Bytes: ' + FBytesEmpfang.ToString);

      FAnzEmpfang := 0;
      FBytesEmpfang := 0;
    end;
  end;
end;

procedure TMyTCPServer.OnServerReadData(Sender: TObject; aData : TDataRec);
var
  IData : AnsiString;
begin
  if not Assigned(aData.Context) then
  begin
    TForm1(FForm).Log('Receive: ' +
      ' Fehler bei Daten von Client: ungültige Context-Angabe');

    Exit;
  end;

  if not Assigned(aData.Context.Binding) then
  begin
    TForm1(FForm).Log('Receive: ' +
      ' Fehler bei Daten von Client: ungültige Binding-Angabe');

    Exit;
  end;

  SetLength(IData,Length(aData.Daten));
  Move(aData.Daten[0],IData[1],Length(aData.Daten));

  //irgendwas mit den Daten machen...
end;

procedure TMyTCPServer.Start;
begin
  FParentServer.Active := True;
end;

procedure TMyTCPServer.Stop;
begin
  FParentServer.Active := False;
end;

{ TSendeThread }

constructor TSendeThread.Create(aParent: TMyTCPServer; ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  FParent := aParent;

  PrtGes := True;

  Anz := 0;
  inherited Create(False);
end;

procedure TSendeThread.Execute;
var
  Data: TIdBytes;
begin
  while not Terminated do
  begin
    if Assigned(FParent) and Assigned(FParent.FParentServer) then
    begin
      Data := FDataQueue.Dequeue;
      if Length(Data) > 0 then
      begin
        Inc(Anz, Length(Data));

        if FParent.FParentServer.UseNagle then
          TForm1(FParent.FForm).Log('01-Server: UseNagle aktiv');

        if FParent.ReadingIsActiv then
          TForm1(FParent.FForm).Log('01-Server: Lesevorgang parallel aktiv');

        if Assigned(FParent.FLastContext) then
        begin
          var sw3 := TStopwatch.StartNew;
          var t3 : Int64;

          if FParent.FLastContext.Connection.Connected then
          begin
            FParent.FLastContext.Connection.IOHandler.WriteDirect(Data);

            TForm1(FParent.FForm).Log('01-Server: Gesendet. Restanzahl: ' + FDataQueue.FQueue.Count.ToString);
          end;

          t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
          if t3 > 50 then
            TForm1(FParent.FForm).Log('Zeitdauer Senden: [' + t3.ToString + ']');

        end;
      end
      else
        Sleep(1);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestData: TIdBytes;
  tmpInt : Integer;
begin
  if not Assigned(MyServer) then
    Exit;

  for var i := 1 to 100 do
  begin
    tmpInt := Random(60000);
    if tmpInt < 10 then
      tmpInt := 10;

    SetLength(TestData, 60000);
    FillChar(TestData[0], Length(TestData), 65);

    MyServer.FSendeDataQueue.Enqueue(TestData);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;

  SL := TStringList.Create;
  Memo1.Clear;

  try
    MyServer := TMyTCPServer.Create(Self);
    MyServer.Start;

    Log('Server läuft auf Port 5000');
  except
    on E: Exception do
      Log('Fehler: ' + E.Message);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyServer.Stop;
  FreeAndNil(MyServer);
  FreeAndNil(SL);
end;

procedure TForm1.Log(aStr : String);
begin
  SL.Add(aStr);

  if UpdateTimer.Enabled then
    Exit;

  UpdateTimer.Enabled := True;
end;

procedure TForm1.UpdateTimerTimer(Sender: TObject);
begin
  UpdateTimer.Enabled := False;

  Memo1.Lines.Text := SL.Text;
end;

end.

[Kas Ob.]

You are accessing VCL from execute ?!!!!!!!!!!!!

That is wrong, and must not be done.

Sebastian had spend his time writing you a working and correct example to build upon, that doesn't call and use VCL element from background thread, it is to the point and will serve you quite well, re-use his code.

the only thing i prefer in his code to switch to blocking instead of using Sleep(1),

@AJ_Oldendorf, the following is not for you for now:
Sleep(1) in tight loop will in best case scenario will cause 50 (to be accurate 64) context switch and that if the time period is default at 1000/64=15.625ms, in worst case when time period is 1, this will cause 1000 context switch per socket !, that is just a waste of CPU cycles, as this loop will continue as long the operation alive, even if modern CPU will handle this like nothing and Process Explorer will report this usage in %0.01 CPU usage, it is still waste cycles. Also on server expecting a hundred connection or even thousands, any application on the server can change this period and raising the context switch to what ! a million,
Best approach handling IO operation is asynchronous IO ( overlapped, IOCP ..) , the next is blocking, then lastly the worst of them is looping over poll and sleep/switch.

here a screen shot from this moment, my device is running long test for an application that utilize %25 (one core) with only 3 threads for hours now, also the IDE is opened, two browser (LibreWOlf and Supermium) with thunderbird, look at the context switch delta with how many threads are running.
Anhang 57486
For me that is healthy OS with healthy applications behavior.

[AJ_Oldendorf]

Ich rufe KEINE VCL Dinge aus einem Thread auf. Das ist mir durchaus Bewusst, dass man das NICHT darf.
Meine Log-Funktion ist entkoppelt über ein Timer (Enabled) und somit Thread-safe.

Entfernen Sie bitte das Sleep(1) und Sie werden sehen, dass die CPU Auslastung auf 6-7% geht wenn keim Empfang stattfindet. Das ist sicherlich nicht normal und daher das Sleep(1). Hat Sebastian auch so bestätigt

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547897)

Ich rufe KEINE VCL Dinge aus einem Thread auf. Das ist mir durchaus Bewusst, dass man das NICHT darf.
Meine Log-Funktion ist entkoppelt über ein Timer (Enabled) und somit Thread-safe.

Entfernen Sie bitte das Sleep(1) und Sie werden sehen, dass die CPU Auslastung auf 6-7% geht wenn keim Empfang stattfindet. Das ist sicherlich nicht normal und daher das Sleep(1). Hat Sebastian auch so bestätigt

After running the code, i am not angry, i am amazed that is running without a exception or all kind of problem.

Any way the code somehow is running with no problem, so try the following one method and see the result

Delphi-Quellcode:

procedure TMyTCPServer.OnExecuteHandler(AContext: TIdContext);
var
  Buffer: TIdBytes;
begin
  FLastContext := AContext;
  AContext.Connection.IOHandler.ReadTimeout := IdTimeoutInfinite; // Wait indefinitely

  try
    ReadingIsActiv := True;

    AContext.Connection.IOHandler.ReadBytes(Buffer, -1, False); // blocking read -1 means read all available

    if Length(Buffer) > 0 then
    begin
      Inc(FAnzEmpfang);
      Inc(FBytesEmpfang, Length(Buffer));
      FDataQueue.Enqueue(Buffer);

      // either "TThread.Queue(nil,..", (nil for main thread) or siwtch to Synchronize
      TThread.Queue(nil, procedure
      begin
        TForm1(FForm).Log('Receive-Anzahl: ' + FAnzEmpfang.ToString);
        TForm1(FForm).Log('Receive-Bytes: ' + FBytesEmpfang.ToString);
        FAnzEmpfang := 0;
        FBytesEmpfang := 0;
      end);
    end;
  except
    on E: Exception do
    begin
      // same as above
      TThread.Queue(nil, procedure
      begin
        TForm1(FForm).Log('Error: ' + E.Message);
      end);
    end;
  end;

  ReadingIsActiv := False;
end;

[Kas Ob.]

Also try this

Delphi-Quellcode:

procedure TMyTCPServer.OnExecuteHandler(AContext: TIdContext);
var
  Buffer: TIdBytes;
begin
  // FLastContext := AContext;  // if needed, yet how it is useful in multihtreaded server/application ?!
  // removed ReadingIsActiv , don't understand it usefulness

  if AContext.Connection.IOHandler.CheckForDataOnSource(10) then
  begin
      AContext.Connection.IOHandler.ReadBytes(Buffer, -1, False);
      if Length(Buffer) > 0 then
      begin
        Inc(FAnzEmpfang);
        Inc(FBytesEmpfang, Length(Buffer));
        FDataQueue.Enqueue(Buffer);

        TThread.Queue(nil, procedure
        begin
          TForm1(FForm).Log('Receive-Anzahl: ' + FAnzEmpfang.ToString);
          TForm1(FForm).Log('Receive-Bytes: ' + FBytesEmpfang.ToString);
          FAnzEmpfang := 0;
          FBytesEmpfang := 0;
        end);
      end;
  end;
end;

Simpler not blocking forever and still using the poll state but at 10ms, meaning at wrost case scenario it will be 100 times per second.

[AJ_Oldendorf]

Ich denke ihr Code ist nicht besser. Siehe Ergebnis

Vorher habe ich im Server 2-3 Empfangsaufrufe gehabt worin meine 12200000 Bytes übertragen wurden. Jetzt sind es ganz viele Aufrufe mit teilweise 0 Bytes... Das sieht nicht richtig aus.

Das Problem mit dem Schreiben (Write) besteht auch nach wie vor. Ich würde Stand jetzt sagen, es ist schlechter geworden aufgrund des Empfangs.
Write-Problem besteht weiterhin.

Code:

Server läuft auf Port 5000
Receive-Anzahl: 1
Receive-Bytes: 65536
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 7
Receive-Bytes: 229376
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 32768
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 3
Receive-Bytes: 98304
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 2
Receive-Bytes: 65536
Receive-Anzahl: 0
Receive-Bytes: 0
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 32768
Receive-Anzahl: 1
Receive-Bytes: 19376
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 99
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 98
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 97
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 96
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 95
01-Server: Lesevorgang parallel aktiv

Auch der zweite Vorschlag https://www.delphipraxis.net/1547899-post50.html bringt das gleiche Ergebnis. Haben Sie den Code selber getestet?

[jaenicke]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547897)

Meine Log-Funktion ist entkoppelt über ein Timer (Enabled) und somit Thread-safe.

Nicht ganz. Der Zugriff auf die visuelle Komponente passiert im Hauptthread, aber beide Threads greifen ohne Synchronisation auf die Stringliste zu.

Ich komme jetzt gerade nicht dazu, mir das genauer anzuschauen. Ich versuche es heute Abend.

[Kas Ob.]

Still the translation playing with my head (may be),

And still don't understand the problem quite right, i am running the code, and i am amazed like the famous meme, it is running without a exception and memory corruption, the code i provided is only for one part, the most critical one you were after the TCP reading shipping down the pipe, but there is still bugs and problem in the code so

1) there is few other places you need to fix the VCL usage in them namely these
TProcessingThread.Execute
TSendeThread.Execute
TMyTCPServer.OnServerReadData
and that is server side

2) I don't understand you complain about 0, you are using multithreading and sharing data, so yes 0 is very possible here.

3) translation gives me this phrase "The write problem still exists." , i am not sure what this is about, as these lines doesn't show when i am running your original code, the code i didn't change anything except removing few inline variables

Code:

01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 99
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 98
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 97
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 96
01-Server: Lesevorgang parallel aktiv
01-Server: Gesendet. Restanzahl: 95
01-Server: Lesevorgang parallel aktiv

These i don't see them !

[Uwe Raabe]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547897)

Ich rufe KEINE VCL Dinge aus einem Thread auf. Das ist mir durchaus Bewusst, dass man das NICHT darf.
Meine Log-Funktion ist entkoppelt über ein Timer (Enabled) und somit Thread-safe.

Ergänzend zu Sebastians Kommentar liegst du hier leider noch aus anderen Gründen falsch. Das Setzen von TTimer.Enabled ruft intern ein SetTimer auf. Dort steht in der Doku zum ersten Parameter:

Zitat:

A handle to the window to be associated with the timer. This window must be owned by the calling thread.

Wenn du VCL-Aufrufe aus einem Thread entkoppeln willst, dann verwende besser Synchronize oder Queue.

[Kas Ob.]

Client also has the same problematic thread access like the server, these should be fixed.

[AJ_Oldendorf]

Danke Sebastian, guck mal drauf.

So sieht es jetzt aktuell aus, habe beim Client noch den Empfang eingebaut aber der läuft noch nicht. Da bin ich noch auf der Suche.
Wie gesagt, bitte Nachsicht bei Benennung und Struktur haben, dass ist nur grob zusammengeworfen.

Beim Client muss ich auch noch gucken, da steht im Memo immer nach dem Start, dass UseNagle aktiv wäre, obwohl es ausgeschaltet ist. Das suche ich auch noch. Hauptproblem ist aber wirklich das Write im Server

Client:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  System.SyncObjs, IdContext, IdGlobal, System.Generics.Collections,
  System.Diagnostics, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TMyTCPClient = class;

  TDataRec = record
    Daten : TIdBytes;
    Context : TIdContext;
  end;

  TReceiveEvent = procedure(Sender: TObject; aData : TDataRec) of Object;

  TDataQueue = class
  private
    FQueue: TQueue<TDataRec>;
    FLock: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enqueue(const Data: TDataRec);
    function Dequeue: TDataRec;
  end;

  TProcessingThread = class(TThread)
  private
    FDataQueue: TDataQueue;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    OnReceive : TReceiveEvent;

    constructor Create(ADataQueue: TDataQueue);
  end;

  TReceiveThread = class(TThread)
  private
    FDataQueue: TDataQueue;
    FParent : TMyTCPClient;
    PrtGes : Boolean;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    constructor Create(aParent : TMyTCPClient; ADataQueue: TDataQueue);
  end;

  TMyTCPClient = class
  private
    FDataQueue       : TDataQueue;
    FProcessingThread: TProcessingThread;

    FReceiveThread: TReceiveThread;

    FParentClient : TIdTCPClient;
    FForm : TForm;

    procedure OnClientReadData(Sender: TObject; aData : TDataRec);
  public
    constructor Create(aForm : TForm);
    destructor Destroy; override;
    procedure MyConnect(const AHost: string; APort: Integer);
    procedure Disconnect;
    procedure SendData(const Data: TDataRec);
  end;

  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdIOHandlerStack1: TIdIOHandlerStack;
    Memo1: TMemo;
    UpdateTimer: TTimer;
    Button1: TButton;
    procedure UpdateTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    MyClient: TMyTCPClient;
    SL : TStringList;
  public
    { Public-Deklarationen }
    procedure Log(aStr : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDataQueue }

constructor TDataQueue.Create;
begin
  FQueue := TQueue<TDataRec>.Create;
  FLock := TCriticalSection.Create;
end;

destructor TDataQueue.Destroy;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

function TDataQueue.Dequeue: TDataRec;
begin
  FLock.Acquire;
  try
    if FQueue.Count > 0 then
      Result := FQueue.Dequeue
    else
    begin
      SetLength(Result.Daten, 0);
      Result.Context := Nil;
    end;
  finally
    FLock.Release;
  end;
end;

procedure TDataQueue.Enqueue(const Data: TDataRec);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
end;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  Anz := 0;
  inherited Create(False);
end;

procedure TProcessingThread.Execute;
var
  Data: TDataRec;
begin
  while not Terminated do
  begin
    Data := FDataQueue.Dequeue;
    if Length(Data.Daten) > 0 then
    begin
      if Assigned(OnReceive) then
        OnReceive(Self, Data);
    end
    else
      Sleep(1);
  end;
end;

{ TReceiveThread }

constructor TReceiveThread.Create(aParent: TMyTCPClient; ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  FParent := aParent;

  if FParent.FParentClient.UseNagle then
    Sleep(1);

  PrtGes := True;

  Anz := 0;
  inherited Create(False);
end;

procedure TReceiveThread.Execute;
var
  Buffer : TIdBytes;
  RecData : TDataRec;
begin
  while not Terminated do
  begin
    if Assigned(FParent) and Assigned(FParent.FParentClient) then
    begin
      if FParent.FParentClient.UseNagle then
        TForm1(FParent.FForm).Log('01-Client(TReceiveThread): UseNagle aktiv');

      if FParent.FParentClient.IOHandler.InputBuffer.Size > 0 then
      begin
        while FParent.FParentClient.IOHandler.InputBuffer.Size > 0 do
        begin
          SetLength(Buffer, FParent.FParentClient.IOHandler.InputBuffer.Size);
          FParent.FParentClient.IOHandler.ReadBytes(Buffer, Length(Buffer), False);

          //Daten in Verarbeitungsliste aufnehmen
          RecData.Daten   := Buffer;
          RecData.Context := Nil;

          FDataQueue.Enqueue(RecData);
        end;
      end
      else
        Sleep(1);
    end;
  end;
end;

{ TMyTCPClient }

procedure TMyTCPClient.MyConnect(const AHost: string; APort: Integer);
begin
  FParentClient.Host := AHost;
  FParentClient.Port := APort;
  FParentClient.ConnectTimeout := 5000; // 5 Sekunden Timeout
  FParentClient.ReadTimeout := 5000; // 5 Sekunden Timeout für Lesevorgänge
  FParentClient.UseNagle := False;
  FParentClient.Connect;
  TForm1(FForm).Log('Verbunden mit ' + AHost + ':' + APort.ToString);
end;

constructor TMyTCPClient.Create(aForm : TForm);
begin
  FForm := aForm;

  FParentClient := TForm1(FForm).IdTCPClient1;

  if FParentClient.UseNagle then
    Sleep(1);

  FDataQueue := TDataQueue.Create;

  //wird nur beim Slave genutzt
  FProcessingThread := TProcessingThread.Create(FDataQueue);
  FProcessingThread.OnReceive := OnClientReadData;

  FReceiveThread := TReceiveThread.Create(Self, FDataQueue);
end;

destructor TMyTCPClient.Destroy;
begin
  if Assigned(FReceiveThread) then
    FreeAndNil(FReceiveThread);

  if Assigned(FProcessingThread) then
    FreeAndNil(FProcessingThread);

  if Assigned(FDataQueue) then
    FreeAndNil(FDataQueue);

  Disconnect;
  inherited;
end;

procedure TMyTCPClient.Disconnect;
begin
  if FParentClient.Connected then
  begin
    FParentClient.Disconnect;
    TForm1(FForm).Log('Verbindung getrennt.');
  end;
end;

procedure TMyTCPClient.SendData(const Data: TDataRec);
begin
  if FParentClient.Connected then
  begin
    if FParentClient.UseNagle then
      TForm1(FForm).Log('01-Client(SendData): UseNagle aktiv');

    FParentClient.IOHandler.WriteDirect(Data.Daten);
    //TForm1(FForm).Log(Now, ' Gesendet: ', Length(Data), ' Bytes');
  end
  else
  begin
    FParentClient.Connect;
    //TForm1(FForm).Log('Fehler: Nicht verbunden.');
  end;
end;

procedure TMyTCPClient.OnClientReadData(Sender: TObject; aData : TDataRec);
var
  IData : AnsiString;
begin
  if not Assigned(FParentClient) then
    Exit;

  SetLength(IData,Length(aData.Daten));
  Move(aData.Daten[0],IData[1],Length(aData.Daten));

  //irgendwas mit den Daten machen...
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestData: TDataRec;
  Anz : LongWord;
begin
  if not Assigned(MyClient) then
    Exit;

  var sw3 := TStopwatch.StartNew;
  var t3 : Int64;

  SetLength(TestData.Daten, 61000); //1024
  FillChar(TestData.Daten[0], Length(TestData.Daten), 65);

  TestData.Context := Nil;

  Anz := 0;

  for var i := 1 to 200 do
  begin
    Inc(Anz, Length(TestData.Daten));

    MyClient.SendData(TestData);
  end;

  t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
  Log('Zeitdauer: ' + t3.ToString + ' ms');

  Log('Gesamtlänge: ' + Anz.ToString + ' Bytes');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SL := TStringList.Create;
  Memo1.Clear;

  IdTCPClient1.UseNagle := False;

  try
    MyClient := TMyTCPClient.Create(Self);
    try
      MyClient.MyConnect('127.0.0.1', 5000);
    finally

    end;
  except
    on E: Exception do
      Log('Fehler: ' + E.Message);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyClient.Disconnect;
  FreeAndNil(MyClient);
  FreeAndNil(SL);
end;

procedure TForm1.Log(aStr : String);
begin
  SL.Add(aStr);

  if UpdateTimer.Enabled then
    Exit;

  UpdateTimer.Enabled := True;
end;

procedure TForm1.UpdateTimerTimer(Sender: TObject);
begin
  UpdateTimer.Enabled := False;

  Memo1.Lines.Text := SL.Text;
end;

end.

Server:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  IdServerIOHandler, IdServerIOHandlerSocket, IdServerIOHandlerStack,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, System.SyncObjs,
  System.Generics.Collections, System.Diagnostics, IdGlobal, IdContext,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TMyTCPServer = class;

  TDataRec = record
    Daten : TIdBytes;
    Context : TIdContext;
  end;

  TReceiveEvent = procedure(Sender: TObject; aData : TDataRec) of Object;

  TDataQueue = class
  private
    FQueue: TQueue<TDataRec>;
    FLock: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enqueue(const Data: TDataRec);
    function Dequeue: TDataRec;
  end;

  TProcessingThread = class(TThread)
  private
    FDataQueue: TDataQueue;

    Anz : LongWord;

    LastPrt : String;

    procedure Log;
  protected
    procedure Execute; override;
  public
    OnReceive : TReceiveEvent;

    constructor Create(ADataQueue: TDataQueue);
  end;

  TSendeThread = class(TThread)
  private
    FDataQueue: TDataQueue;
    FParent : TMyTCPServer;
    PrtGes : Boolean;

    Anz : LongWord;
    LastPrt : String;

    procedure Log;
  protected
    procedure Execute; override;
  public
    constructor Create(aParent : TMyTCPServer; ADataQueue: TDataQueue);
  end;

  TMyTCPServer = class
  private
    FDataQueue: TDataQueue;
    FSendeDataQueue : TDataQueue;
    FParentServer : TIdTCPServer;
    FForm : TForm;

    FProcessingThread: TProcessingThread;
    FSendeThread: TSendeThread;
    FAnzEmpfang : LongWord;
    FBytesEmpfang : LongWord;

    ReadingIsActiv : Boolean;

    LastRecData : TDataRec;

    LastPrt : String;

    LastContext : TIdContext;

    procedure Log;

    procedure OnExecuteHandler(AContext: TIdContext);

    procedure OnServerReadData(Sender: TObject; aData : TDataRec);
  public
    constructor Create(aForm : TForm);
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  end;

  TForm1 = class(TForm)
    IdTCPServer: TIdTCPServer;
    IdServerIOHandlerStack: TIdServerIOHandlerStack;
    Memo1: TMemo;
    UpdateTimer: TTimer;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UpdateTimerTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    MyServer: TMyTCPServer;
    SL : TStringList;
  public
    { Public-Deklarationen }
    procedure Log(aStr : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDataQueue }

constructor TDataQueue.Create;
begin
  FQueue := TQueue<TDataRec>.Create;
  FLock := TCriticalSection.Create;
end;

destructor TDataQueue.Destroy;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

function TDataQueue.Dequeue: TDataRec;
begin
  FLock.Acquire;
  try
    if FQueue.Count > 0 then
      Result := FQueue.Dequeue
    else
    begin
      SetLength(Result.Daten, 0);
      Result.Context := Nil;
    end;
  finally
    FLock.Release;
  end;
end;

procedure TDataQueue.Enqueue(const Data: TDataRec);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
end;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  Anz := 0;
  inherited Create(False);
end;

procedure TProcessingThread.Log;
begin
  //TForm1(FParent.FForm).Log(LastPrt);
end;

procedure TProcessingThread.Execute;
var
  Data: TDataRec;
begin
  while not Terminated do
  begin
    Data := FDataQueue.Dequeue;
    if Length(Data.Daten) > 0 then
    begin
      if Assigned(OnReceive) then
        OnReceive(Self, Data);

      //TForm1(FParent.FForm).Log('Empfangen: ', Length(Data), ' Bytes' + '- Anz: ' + Anz.ToString);
    end
    else
      Sleep(1);

    if (FDataQueue.FQueue.Count = 0) then
    begin
      //TForm1(FParent.FForm).Log('Gesamtlänge Empfang: ' + Anz.ToString + ' Bytes');
    end;
  end;
end;

{ TMyTCPServer }

constructor TMyTCPServer.Create(aForm : TForm);
begin
  FDataQueue := TDataQueue.Create;
  FSendeDataQueue := TDataQueue.Create;

  LastContext := Nil;

  FProcessingThread := TProcessingThread.Create(FDataQueue);
  FProcessingThread.OnReceive := OnServerReadData;

  FSendeThread := TSendeThread.Create(Self, FSendeDataQueue);

  FForm := aForm;

  LastRecData.Context := Nil;

  FParentServer := TForm1(FForm).IdTCPServer;
  FParentServer.DefaultPort := 5000;
  FParentServer.OnExecute := OnExecuteHandler;
end;

destructor TMyTCPServer.Destroy;
begin
  Stop;
  FreeAndNil(FSendeThread);
  FreeAndNil(FProcessingThread);
  FreeAndNil(FSendeDataQueue);
  FreeAndNil(FDataQueue);
  inherited;
end;

procedure TMyTCPServer.Log;
begin
  TForm1(FForm).Log(LastPrt);
end;

procedure TMyTCPServer.OnExecuteHandler(AContext: TIdContext);
var
  Buffer : TIdBytes;
  RecData : TDataRec;
begin
  if AContext.Connection.IOHandler.InputBuffer.Size > 0 then
  begin
    LastContext := AContext;

    ReadingIsActiv := True;
    while AContext.Connection.IOHandler.InputBuffer.Size > 0 do
    begin
      Inc(FAnzEmpfang);
      Inc(FBytesEmpfang, AContext.Connection.IOHandler.InputBuffer.Size);

      SetLength(Buffer, AContext.Connection.IOHandler.InputBuffer.Size); //<- so viel einlesen wie im Buffer enthalten ist
      AContext.Connection.IOHandler.ReadBytes(Buffer, Length(Buffer), False);

      //Daten in Verarbeitungsliste aufnehmen
      RecData.Daten   := Buffer;
      RecData.Context := AContext;

      FDataQueue.Enqueue(RecData);
    end;
    ReadingIsActiv := False;
  end
  else
  begin
    Sleep(1);

    if (FAnzEmpfang <> 0) or (FBytesEmpfang <> 0) then
    begin
      //TForm1(FForm).Log('Receive-Anzahl: ' + FAnzEmpfang.ToString);
      //TForm1(FForm).Log('Receive-Bytes: ' + FBytesEmpfang.ToString);

      FAnzEmpfang := 0;
      FBytesEmpfang := 0;
    end;
  end;
end;

procedure TMyTCPServer.OnServerReadData(Sender: TObject; aData : TDataRec);
var
  IData : AnsiString;
begin
  if not Assigned(aData.Context) then
  begin
    TForm1(FForm).Log('Receive: ' +
      ' Fehler bei Daten von Client: ungültige Context-Angabe');

    Exit;
  end;

  if not Assigned(aData.Context.Binding) then
  begin
    TForm1(FForm).Log('Receive: ' +
      ' Fehler bei Daten von Client: ungültige Binding-Angabe');

    Exit;
  end;

  SetLength(IData,Length(aData.Daten));
  Move(aData.Daten[0],IData[1],Length(aData.Daten));

  LastRecData := aData;

  //irgendwas mit den Daten machen...
end;

procedure TMyTCPServer.Start;
begin
  FParentServer.Active := True;
end;

procedure TMyTCPServer.Stop;
begin
  FParentServer.Active := False;
end;

{ TSendeThread }

constructor TSendeThread.Create(aParent: TMyTCPServer; ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  FParent := aParent;

  PrtGes := True;

  Anz := 0;
  inherited Create(False);
end;

procedure TSendeThread.Log;
begin
  TForm1(FParent.FForm).Log(LastPrt);
end;

procedure TSendeThread.Execute;
var
  Data: TDataRec;
begin
  while not Terminated do
  begin
    if Assigned(FParent) and Assigned(FParent.FParentServer) then
    begin
      Data := FDataQueue.Dequeue;
      if Length(Data.Daten) > 0 then
      begin
        Inc(Anz, Length(Data.Daten));

        if FParent.FParentServer.UseNagle then
        begin
          //TForm1(FParent.FForm).Log('01-Server(TSendeThread): UseNagle aktiv');
        end;

        if FParent.ReadingIsActiv then
        begin
          //TForm1(FParent.FForm).Log('01-Server: Lesevorgang parallel aktiv');
        end;

        {
        if Assigned(Data.Context) and Assigned(Data.Context.Connection) then
        begin
          var sw3 := TStopwatch.StartNew;
          var t3 : Int64;

          if Data.Context.Connection.Connected then
          begin
            Data.Context.Connection.IOHandler.WriteDirect(Data.Daten);

            //TForm1(FParent.FForm).Log('01-Server: Gesendet. Restanzahl: ' + FDataQueue.FQueue.Count.ToString);
          end;

          t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
          if t3 > 50 then
          begin
            //TForm1(FParent.FForm).Log('Zeitdauer Senden: [' + t3.ToString + ']');
          end;

        end;
        }
        if Assigned(FParent.LastContext) and Assigned(FParent.LastContext.Connection) then
        begin
          var sw3 := TStopwatch.StartNew;
          var t3 : Int64;

          if FParent.LastContext.Connection.Connected then
          begin
            FParent.LastContext.Connection.IOHandler.WriteDirect(Data.Daten);

            //TForm1(FParent.FForm).Log('01-Server: Gesendet. Restanzahl: ' + FDataQueue.FQueue.Count.ToString);
          end;

          t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
          if t3 > 50 then
          begin
            //TForm1(FParent.FForm).Log('Zeitdauer Senden: [' + t3.ToString + ']');
          end;

        end;
      end
      else
        Sleep(1);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestData: TDataRec;
  tmpInt : Integer;
begin
  if not Assigned(MyServer) then
    Exit;

  for var i := 1 to 100 do
  begin
    tmpInt := Random(60000);
    if tmpInt < 10 then
      tmpInt := 10;

    SetLength(TestData.Daten, 60000);
    FillChar(TestData.Daten[0], Length(TestData.Daten), 65);

    TestData.Context := Nil;
    if Assigned(MyServer.LastRecData.Context) then
      TestData.Context := MyServer.LastRecData.Context;

    MyServer.FSendeDataQueue.Enqueue(TestData);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;

  SL := TStringList.Create;
  Memo1.Clear;

  try
    MyServer := TMyTCPServer.Create(Self);
    MyServer.Start;

    Log('Server läuft auf Port 5000');
  except
    on E: Exception do
      Log('Fehler: ' + E.Message);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyServer.Stop;
  FreeAndNil(MyServer);
  FreeAndNil(SL);
end;

procedure TForm1.Log(aStr : String);
begin
  Exit;

  System.TMonitor.Enter(SL);
  try
    SL.Add(aStr);

    if UpdateTimer.Enabled then
      Exit;

    UpdateTimer.Enabled := True;
  finally
    System.TMonitor.Exit(SL);
  end;
end;

procedure TForm1.UpdateTimerTimer(Sender: TObject);
begin
  Exit;

  UpdateTimer.Enabled := False;

  System.TMonitor.Enter(SL);
  try
    Memo1.Lines.Text := SL.Text;
  finally
    System.TMonitor.Exit(SL);
  end;
end;

end.

Ok, habe die Kommentare gesehen. Ich gucke wegen dem Timer und der VCL

Edit: TMonitor-Synchronisation für Stringliste eingefügt. Keine Änderung am Verhalten danach

[AJ_Oldendorf]

@Kas Ob.
Main problem is, when you press the button in Server for sending, he only send 5 packets and after this the write command from Indy is hanging...

You see it in the memo:

Code:

01-Server: Gesendet. Restanzahl: 99
01-Server: Gesendet. Restanzahl: 98
01-Server: Gesendet. Restanzahl: 97
01-Server: Gesendet. Restanzahl: 96
01-Server: Gesendet. Restanzahl: 95

Ich gucke wegen dem VCL Thema nach

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547907)

@Kas Ob.
Main problem is, when you press the button in Server for sending, he only send 5 packets and after this the write command from Indy is hanging...

You see it in the memo:

Code:

01-Server: Gesendet. Restanzahl: 99
01-Server: Gesendet. Restanzahl: 98
01-Server: Gesendet. Restanzahl: 97
01-Server: Gesendet. Restanzahl: 96
01-Server: Gesendet. Restanzahl: 95

Ich gucke wegen dem VCL Thema nach

Last chance !
Remove "TForm1(FParent.FForm).Log" from background threads or i will impose tariff on you, that you will never forget, (angry and serious smiley face)

[AJ_Oldendorf]

Ich muss gestehen, der Umgangston lässt leider nach.

Ich habe in

Delphi-Quellcode:

procedure TForm1.Log(aStr : String);

UND

Delphi-Quellcode:

procedure TForm1.UpdateTimerTimer(Sender: TObject);

jeweils ein Exit an erster Stelle eingebaut. Trotzdem wird der Write-Aufruf nur genau 5x durchlaufen und beim 6ten Mal hängt dieser. Es hat nichts mit der VCL zu tun und ich würde mich über einen netteren Umgangston wieder freuen ;-)

Edit:
Am besten mal hier ein Breakpoint machen und gucken, wie oft er rein kommt obwohl die Liste 100 Einträge hat

Delphi-Quellcode:

Data.Context.Connection.IOHandler.WriteDirect(Data.Daten);

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547909)

Ich muss gestehen, der Umgangston lässt leider nach.

Ich habe in

Delphi-Quellcode:

procedure TForm1.Log(aStr : String);

UND

Delphi-Quellcode:

procedure TForm1.UpdateTimerTimer(Sender: TObject);

jeweils ein Exit an erster Stelle eingebaut. Trotzdem wird der Write-Aufruf nur genau 5x durchlaufen und beim 6ten Mal hängt dieser. Es hat nichts mit der VCL zu tun und ich würde mich über einen netteren Umgangston wieder freuen ;-)

Edit:
Am besten mal hier ein Breakpoint machen und gucken, wie oft er rein kommt obwohl die Liste 100 Einträge hat

Delphi-Quellcode:

Data.Context.Connection.IOHandler.WriteDirect(Data.Daten);

Tariff it is !

Seriously, using or lets rephrase it, touching VCL of any kind is wrong, so Log method should be somewhere else not in any kind of TForm, also running the code a see the server is sending fine !

The problem is client is not receiving, it is not performing a real read over socket, the buffer is client side, and here i mean the TCP socket receiving buffer is full, and that after window sliding, hence an ACK is not received by server to continue sending (send over socket), at low level you poll the state of the socket and send only if the socket sate is ready to send, this is not happening on server side, due the accumulation of the data on client side.
That is the server write/send problem with above code.

in other words you must ensure to empty the buffer as soon as possible.

[Kas Ob.]

Here how you can spot it on WireShark
Anhang 57487

[Kas Ob.]

Better screenshot to point the values and the how the receiving window shrank with each recv
Anhang 57488

Notice the server has adjusted its receiving window to the exact received length after the client performed the full send, this is one perk of the Windows TCP stack, dynamically resize, even it wasn't needed, but taking it as this socket had received this then it can handle it again, on other side the window size sent by the client in the ACK, was shrinking until depletion, so server stopped sending and put the socket in not ready to send state, and it will wait until something from the client namely ACK ( being alone or combined with packet) to resume the socket state.

Also this behavior in the screenshot is on loopback, and it is different in few details when the NIC (Network Adapter and its driver) involved.

[AJ_Oldendorf]

Danke Kas Ob., habe ich verstanden.
Ich kümmere mich erstmal um den Empfang im Client.

Kann mal jemand auf die letzte Variante schauen?
Im Client läuft der

Delphi-Quellcode:

TReceiveThread.Execute

die ganze Zeit aber der InputBuffer ist immer leer. Irgendwie sehe ich das Problem gerade nicht, der Server schickt die Daten ja ab mit dem Write-Befehl

[AJ_Oldendorf]

Noch eine Anmerkung:
Wenn ich vom Server nicht TIdBytes verschicke mit Write/WriteDirect, sondern ein einfachen String mit WriteLn,
wird es vom Client in dem ReceiveThread mit ReadLn auch empfangen.
Ich will aber vom Server TIdBytes senden und im Client TIdBytes empfangen.
Jemand eine Idee, was da falsch sein könnte?

Edit:
Mit der Version habe ich zuletzt getestet:
https://www.delphipraxis.net/1547906-post56.html

[jaenicke]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547928)

Im Client läuft der

Delphi-Quellcode:

TReceiveThread.Execute

die ganze Zeit aber der InputBuffer ist immer leer. Irgendwie sehe ich das Problem gerade nicht, der Server schickt die Daten ja ab mit dem Write-Befehl

Ich bin gestern nicht dazu gekommen und konnte eben auch nur einen kurzen Blick auf den Code aus deinem letzten Beitrag werfen, aber ich sehe nicht, wo du den Context in deinen Daten zuweist. Du setzt das in Button1Click auf nil und dann auf den Context aus LastRecData, aber wie soll der denn da reinkommen, wenn er immer nur nil war?

Ich gehe also davon aus, dass das Senden an dieser Zeile scheitert:

Delphi-Quellcode:

        if Assigned(Data.Context) and Assigned(Data.Context.Connection) then
        ...

Das solltest du aber doch sofort im Debugger sehen, wenn du da zeilenweise durchgehst.

[AJ_Oldendorf]

Ich habe den Code nochmal aktualisiert aber ich arbeite mit LastContext (wird sich beim Empfang gemerkt).
Das mit dem Context in dem Record, habe ich nur vorbereitet wenn mehrere verschiedene Clients sich anmelden.
Im Debugger wird das .Write auch aufgerufen, er bricht also vorher nicht ab.
Ich behaupte, es liegt am Client.
Sende ich im Server nicht mit .Write sondern alternativ mit WriteLn, reagiert der ReceiveThread im Client auch darauf mit ReadLn. Ich will ja aber TIdBytes verschicken

[Kas Ob.]

The problem is checking or polling on IOHandler.InputBuffer.Size in TReceiveThread.Execute;

Delphi-Quellcode:

if FParent.FParentClient.IOHandler.InputBuffer.Size > 0 then

Try it this way, the right one

Delphi-Quellcode:

procedure TReceiveThread.Execute;
var
  Buffer : TIdBytes;
  RecData : TDataRec;
begin
  while not Terminated do
  begin
    if Assigned(FParent) and Assigned(FParent.FParentClient) and FParent.FParentClient.Connected then
    begin

      FParent.FParentClient.IOHandler.ReadBytes(Buffer, -1, False); // blocks and wait, no need to Ssleep()

      if Length(Buffer) > 0 then
      begin
        RecData.Daten := Buffer;
        RecData.Context := Nil;
        FDataQueue.Enqueue(RecData);
        Inc(Anz, Length(Buffer));

        TThread.Queue(nil,
          procedure
          begin
            TForm1(FParent.FForm).Log('Received ' + Length(Buffer).ToString + ' bytes');
          end
        );
      end;
    end;
  end;
end;

This will fix reading and client is reading everything now, this is a right fix but really the whole code should be refactored better.

About Nagle and it is important : you don't need it if you are sending huge buffers !, just in case sending small packets at very short times frequently, so it will not have an impact on you performing client/server.

[AJ_Oldendorf]

Danke Kas Ob. für die Korrektur des Codes allerdings funktioniert auch dieser nicht.
Hast du den Code getestet von dir?

Ein Breakpoint auf

Delphi-Quellcode:

if Length(Buffer) > 0 then

reicht aus, dort kommt der Debugger nämlich nie an.
Der Server ruft das Write auf (dort lande ich wie bereits gesagt, 5x im Debugger)

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547942)

Danke Kas Ob. für die Korrektur des Codes allerdings funktioniert auch dieser nicht.
Hast du den Code getestet von dir?

Ein Breakpoint auf

Delphi-Quellcode:

if Length(Buffer) > 0 then

reicht aus, dort kommt der Debugger nämlich nie an.
Der Server ruft das Write auf (dort lande ich wie bereits gesagt, 5x im Debugger)

I test the client only that you pointed to at https://www.delphipraxis.net/1547906-post56.html
As i have working and fixed server, and i had point the most critical problem in the server in earlier post i fixed one method and the server no more using high CPU and sending and reading right, although i mentioned there is so many problem with code...
anyway when i suggested a fix on the client then i used your client you pointed to in the same post https://www.delphipraxis.net/1547906-post56.html , now the client is receiving right and both works, although again there is so many problem in both ....

Anyway you server in https://www.delphipraxis.net/1547906-post56.html didn't adopt my fixes yet it is working, but by your broken design you should run server then client then click send ( the button) on the client then and only then you can click the button the server, the server is not logging anything by your code in the post mentioned https://www.delphipraxis.net/1547906-post56.html
but the client is receiving fine and looking at WireShark there is no problem whatsoever on in sending and receiving on both.

Your server is adopting broken way to send, as send to the last client, and so many problem as i pointed many of them..

My suggestions both are perfect fix for one and only one method, test them or adopt them, it is up to you but for sure i tested and confirm they fix your main problem which is send and receiving with minimum CPU usage.

[AJ_Oldendorf]

Also wir lassen jetzt mal die Struktur des Codes und alle "Nebensächlichkeiten" unberücksichtigt und gucken nur auf das Empfangsproblem beim Client.

Client:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  System.SyncObjs, IdContext, IdGlobal, System.Generics.Collections,
  System.Diagnostics, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TMyTCPClient = class;

  TDataRec = record
    Daten : TIdBytes;
    Context : TIdContext;
  end;

  TReceiveEvent = procedure(Sender: TObject; aData : TDataRec) of Object;

  TDataQueue = class
  private
    FQueue: TQueue<TDataRec>;
    FLock: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enqueue(const Data: TDataRec);
    function Dequeue: TDataRec;
  end;

  TProcessingThread = class(TThread)
  private
    FDataQueue: TDataQueue;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    OnReceive : TReceiveEvent;

    constructor Create(ADataQueue: TDataQueue);
  end;

  TReceiveThread = class(TThread)
  private
    FDataQueue: TDataQueue;
    FParent : TMyTCPClient;
    PrtGes : Boolean;

    Anz : LongWord;
  protected
    procedure Execute; override;
  public
    constructor Create(aParent : TMyTCPClient; ADataQueue: TDataQueue);
  end;

  TMyTCPClient = class
  private
    FDataQueue       : TDataQueue;
    FProcessingThread: TProcessingThread;

    FReceiveThread: TReceiveThread;

    FParentClient : TIdTCPClient;
    FForm : TForm;

    procedure OnClientReadData(Sender: TObject; aData : TDataRec);
  public
    constructor Create(aForm : TForm);
    destructor Destroy; override;
    procedure MyConnect(const AHost: string; APort: Integer);
    procedure Disconnect;
    procedure SendData(const Data: TDataRec);
  end;

  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdIOHandlerStack1: TIdIOHandlerStack;
    Memo1: TMemo;
    UpdateTimer: TTimer;
    Button1: TButton;
    procedure UpdateTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    MyClient: TMyTCPClient;
    SL : TStringList;
  public
    { Public-Deklarationen }
    procedure Log(aStr : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDataQueue }

constructor TDataQueue.Create;
begin
  FQueue := TQueue<TDataRec>.Create;
  FLock := TCriticalSection.Create;
end;

destructor TDataQueue.Destroy;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

function TDataQueue.Dequeue: TDataRec;
begin
  FLock.Acquire;
  try
    if FQueue.Count > 0 then
      Result := FQueue.Dequeue
    else
    begin
      SetLength(Result.Daten, 0);
      Result.Context := Nil;
    end;
  finally
    FLock.Release;
  end;
end;

procedure TDataQueue.Enqueue(const Data: TDataRec);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
end;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  Anz := 0;
  inherited Create(False);
end;

procedure TProcessingThread.Execute;
var
  Data: TDataRec;
begin
  while not Terminated do
  begin
    Data := FDataQueue.Dequeue;
    if Length(Data.Daten) > 0 then
    begin
      if Assigned(OnReceive) then
        OnReceive(Self, Data);
    end
    else
      Sleep(1);
  end;
end;

{ TReceiveThread }

constructor TReceiveThread.Create(aParent: TMyTCPClient; ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  FParent := aParent;

  if FParent.FParentClient.UseNagle then
    Sleep(1);

  PrtGes := True;

  Anz := 0;
  inherited Create(False);
end;

procedure TReceiveThread.Execute;
var
  Buffer : TIdBytes;
  RecData : TDataRec;
begin
  while not Terminated do
  begin
    if Assigned(FParent) and Assigned(FParent.FParentClient) then
    begin
      FParent.FParentClient.IOHandler.ReadBytes(Buffer, -1, False); // blocks and wait, no need to Ssleep()

      if Length(Buffer) > 0 then
      begin
        RecData.Daten := Buffer;
        RecData.Context := Nil;
        FDataQueue.Enqueue(RecData);

        Inc(Anz, Length(Buffer));

        TThread.Queue(nil,
          procedure
          begin
            TForm1(FParent.FForm).Log('Received ' + Length(Buffer).ToString + ' bytes');
          end
        );
      end;

      {
      if FParent.FParentClient.UseNagle then
        TForm1(FParent.FForm).Log('01-Client(TReceiveThread): UseNagle aktiv');

      if FParent.FParentClient.IOHandler.InputBuffer.Size > 0 then
      begin
        while FParent.FParentClient.IOHandler.InputBuffer.Size > 0 do
        begin
          SetLength(Buffer, FParent.FParentClient.IOHandler.InputBuffer.Size);
          FParent.FParentClient.IOHandler.ReadBytes(Buffer, Length(Buffer), False);

          //Daten in Verarbeitungsliste aufnehmen
          RecData.Daten   := Buffer;
          RecData.Context := Nil;

          FDataQueue.Enqueue(RecData);
        end;
      end
      else
        Sleep(1);
        }
    end;
  end;
end;

{ TMyTCPClient }

procedure TMyTCPClient.MyConnect(const AHost: string; APort: Integer);
begin
  FParentClient.Host := AHost;
  FParentClient.Port := APort;
  FParentClient.ConnectTimeout := 5000; // 5 Sekunden Timeout
  FParentClient.ReadTimeout := 5000; // 5 Sekunden Timeout für Lesevorgänge
  FParentClient.UseNagle := False;
  FParentClient.Connect;
  TForm1(FForm).Log('Verbunden mit ' + AHost + ':' + APort.ToString);
end;

constructor TMyTCPClient.Create(aForm : TForm);
begin
  FForm := aForm;

  FParentClient := TForm1(FForm).IdTCPClient1;

  if FParentClient.UseNagle then
    Sleep(1);

  FDataQueue := TDataQueue.Create;

  //wird nur beim Slave genutzt
  FProcessingThread := TProcessingThread.Create(FDataQueue);
  FProcessingThread.OnReceive := OnClientReadData;

  FReceiveThread := TReceiveThread.Create(Self, FDataQueue);
end;

destructor TMyTCPClient.Destroy;
begin
  if Assigned(FReceiveThread) then
    FreeAndNil(FReceiveThread);

  if Assigned(FProcessingThread) then
    FreeAndNil(FProcessingThread);

  if Assigned(FDataQueue) then
    FreeAndNil(FDataQueue);

  Disconnect;
  inherited;
end;

procedure TMyTCPClient.Disconnect;
begin
  if FParentClient.Connected then
  begin
    FParentClient.Disconnect;
    TForm1(FForm).Log('Verbindung getrennt.');
  end;
end;

procedure TMyTCPClient.SendData(const Data: TDataRec);
begin
  if FParentClient.Connected then
  begin
    if FParentClient.UseNagle then
      TForm1(FForm).Log('01-Client(SendData): UseNagle aktiv');

    FParentClient.IOHandler.WriteDirect(Data.Daten);
    //TForm1(FForm).Log(Now, ' Gesendet: ', Length(Data), ' Bytes');
  end
  else
  begin
    FParentClient.Connect;
    //TForm1(FForm).Log('Fehler: Nicht verbunden.');
  end;
end;

procedure TMyTCPClient.OnClientReadData(Sender: TObject; aData : TDataRec);
var
  IData : AnsiString;
begin
  if not Assigned(FParentClient) then
    Exit;

  SetLength(IData,Length(aData.Daten));
  Move(aData.Daten[0],IData[1],Length(aData.Daten));

  //irgendwas mit den Daten machen...
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestData: TDataRec;
  Anz : LongWord;
begin
  if not Assigned(MyClient) then
    Exit;

  var sw3 := TStopwatch.StartNew;
  var t3 : Int64;

  SetLength(TestData.Daten, 61000); //1024
  FillChar(TestData.Daten[0], Length(TestData.Daten), 65);

  TestData.Context := Nil;

  Anz := 0;

  for var i := 1 to 200 do
  begin
    Inc(Anz, Length(TestData.Daten));

    MyClient.SendData(TestData);
  end;

  t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
  Log('Zeitdauer: ' + t3.ToString + ' ms');

  Log('Gesamtlänge: ' + Anz.ToString + ' Bytes');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SL := TStringList.Create;
  Memo1.Clear;

  IdTCPClient1.UseNagle := False;

  try
    MyClient := TMyTCPClient.Create(Self);
    try
      MyClient.MyConnect('127.0.0.1', 5000);
    finally

    end;
  except
    on E: Exception do
      Log('Fehler: ' + E.Message);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyClient.Disconnect;
  FreeAndNil(MyClient);
  FreeAndNil(SL);
end;

procedure TForm1.Log(aStr : String);
begin
  Exit;

  SL.Add(aStr);

  if UpdateTimer.Enabled then
    Exit;

  UpdateTimer.Enabled := True;
end;

procedure TForm1.UpdateTimerTimer(Sender: TObject);
begin
  Exit;

  UpdateTimer.Enabled := False;

  Memo1.Lines.Text := SL.Text;
end;

end.

VCL Zugriffe sind deaktiviert!
Es erfolgt trotzdem kein Aufruf am Breakpoint in Funktion

Delphi-Quellcode:

procedure TReceiveThread.Execute;

bei

Delphi-Quellcode:

if Length(Buffer) > 0 then

Hier der Server

Server:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  IdServerIOHandler, IdServerIOHandlerSocket, IdServerIOHandlerStack,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, System.SyncObjs,
  System.Generics.Collections, System.Diagnostics, IdGlobal, IdContext,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TMyTCPServer = class;

  TDataRec = record
    Daten : TIdBytes;
    Context : TIdContext;
  end;

  TReceiveEvent = procedure(Sender: TObject; aData : TDataRec) of Object;

  TDataQueue = class
  private
    FQueue: TQueue<TDataRec>;
    FLock: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Enqueue(const Data: TDataRec);
    function Dequeue: TDataRec;
  end;

  TProcessingThread = class(TThread)
  private
    FDataQueue: TDataQueue;

    Anz : LongWord;

    LastPrt : String;

    procedure Log;
  protected
    procedure Execute; override;
  public
    OnReceive : TReceiveEvent;

    constructor Create(ADataQueue: TDataQueue);
  end;

  TSendeThread = class(TThread)
  private
    FDataQueue: TDataQueue;
    FParent : TMyTCPServer;
    PrtGes : Boolean;

    Anz : LongWord;
    LastPrt : String;

    procedure Log;
  protected
    procedure Execute; override;
  public
    constructor Create(aParent : TMyTCPServer; ADataQueue: TDataQueue);
  end;

  TMyTCPServer = class
  private
    FDataQueue: TDataQueue;
    FSendeDataQueue : TDataQueue;
    FParentServer : TIdTCPServer;
    FForm : TForm;

    FProcessingThread: TProcessingThread;
    FSendeThread: TSendeThread;
    FAnzEmpfang : LongWord;
    FBytesEmpfang : LongWord;

    ReadingIsActiv : Boolean;

    LastRecData : TDataRec;

    LastPrt : String;

    LastContext : TIdContext;

    procedure Log;

    procedure OnExecuteHandler(AContext: TIdContext);

    procedure OnServerReadData(Sender: TObject; aData : TDataRec);
  public
    constructor Create(aForm : TForm);
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  end;

  TForm1 = class(TForm)
    IdTCPServer: TIdTCPServer;
    IdServerIOHandlerStack: TIdServerIOHandlerStack;
    Memo1: TMemo;
    UpdateTimer: TTimer;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UpdateTimerTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    MyServer: TMyTCPServer;
    SL : TStringList;
  public
    { Public-Deklarationen }
    procedure Log(aStr : String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDataQueue }

constructor TDataQueue.Create;
begin
  FQueue := TQueue<TDataRec>.Create;
  FLock := TCriticalSection.Create;
end;

destructor TDataQueue.Destroy;
begin
  FQueue.Free;
  FLock.Free;
  inherited;
end;

function TDataQueue.Dequeue: TDataRec;
begin
  FLock.Acquire;
  try
    if FQueue.Count > 0 then
      Result := FQueue.Dequeue
    else
    begin
      SetLength(Result.Daten, 0);
      Result.Context := Nil;
    end;
  finally
    FLock.Release;
  end;
end;

procedure TDataQueue.Enqueue(const Data: TDataRec);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
end;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  Anz := 0;
  inherited Create(False);
end;

procedure TProcessingThread.Log;
begin
  //TForm1(FParent.FForm).Log(LastPrt);
end;

procedure TProcessingThread.Execute;
var
  Data: TDataRec;
begin
  while not Terminated do
  begin
    Data := FDataQueue.Dequeue;
    if Length(Data.Daten) > 0 then
    begin
      if Assigned(OnReceive) then
        OnReceive(Self, Data);

      //TForm1(FParent.FForm).Log('Empfangen: ', Length(Data), ' Bytes' + '- Anz: ' + Anz.ToString);
    end
    else
      Sleep(1);

    if (FDataQueue.FQueue.Count = 0) then
    begin
      //TForm1(FParent.FForm).Log('Gesamtlänge Empfang: ' + Anz.ToString + ' Bytes');
    end;
  end;
end;

{ TMyTCPServer }

constructor TMyTCPServer.Create(aForm : TForm);
begin
  FDataQueue := TDataQueue.Create;
  FSendeDataQueue := TDataQueue.Create;

  LastContext := Nil;

  FProcessingThread := TProcessingThread.Create(FDataQueue);
  FProcessingThread.OnReceive := OnServerReadData;

  FSendeThread := TSendeThread.Create(Self, FSendeDataQueue);

  FForm := aForm;

  LastRecData.Context := Nil;

  FParentServer := TForm1(FForm).IdTCPServer;
  FParentServer.DefaultPort := 5000;
  FParentServer.OnExecute := OnExecuteHandler;
end;

destructor TMyTCPServer.Destroy;
begin
  Stop;
  FreeAndNil(FSendeThread);
  FreeAndNil(FProcessingThread);
  FreeAndNil(FSendeDataQueue);
  FreeAndNil(FDataQueue);
  inherited;
end;

procedure TMyTCPServer.Log;
begin
  TForm1(FForm).Log(LastPrt);
end;

procedure TMyTCPServer.OnExecuteHandler(AContext: TIdContext);
var
  Buffer : TIdBytes;
  RecData : TDataRec;
begin
  if AContext.Connection.IOHandler.InputBuffer.Size > 0 then
  begin
    LastContext := AContext;

    ReadingIsActiv := True;
    while AContext.Connection.IOHandler.InputBuffer.Size > 0 do
    begin
      Inc(FAnzEmpfang);
      Inc(FBytesEmpfang, AContext.Connection.IOHandler.InputBuffer.Size);

      SetLength(Buffer, AContext.Connection.IOHandler.InputBuffer.Size); //<- so viel einlesen wie im Buffer enthalten ist
      AContext.Connection.IOHandler.ReadBytes(Buffer, Length(Buffer), False);

      //Daten in Verarbeitungsliste aufnehmen
      RecData.Daten   := Buffer;
      RecData.Context := AContext;

      FDataQueue.Enqueue(RecData);
    end;
    ReadingIsActiv := False;
  end
  else
  begin
    Sleep(1);

    if (FAnzEmpfang <> 0) or (FBytesEmpfang <> 0) then
    begin
      //TForm1(FForm).Log('Receive-Anzahl: ' + FAnzEmpfang.ToString);
      //TForm1(FForm).Log('Receive-Bytes: ' + FBytesEmpfang.ToString);

      FAnzEmpfang := 0;
      FBytesEmpfang := 0;
    end;
  end;
end;

procedure TMyTCPServer.OnServerReadData(Sender: TObject; aData : TDataRec);
var
  IData : AnsiString;
begin
  if not Assigned(aData.Context) then
  begin
    TForm1(FForm).Log('Receive: ' +
      ' Fehler bei Daten von Client: ungültige Context-Angabe');

    Exit;
  end;

  if not Assigned(aData.Context.Binding) then
  begin
    TForm1(FForm).Log('Receive: ' +
      ' Fehler bei Daten von Client: ungültige Binding-Angabe');

    Exit;
  end;

  SetLength(IData,Length(aData.Daten));
  Move(aData.Daten[0],IData[1],Length(aData.Daten));

  LastRecData := aData;

  //irgendwas mit den Daten machen...
end;

procedure TMyTCPServer.Start;
begin
  FParentServer.Active := True;
end;

procedure TMyTCPServer.Stop;
begin
  FParentServer.Active := False;
end;

{ TSendeThread }

constructor TSendeThread.Create(aParent: TMyTCPServer; ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  FParent := aParent;

  PrtGes := True;

  Anz := 0;
  inherited Create(False);
end;

procedure TSendeThread.Log;
begin
  TForm1(FParent.FForm).Log(LastPrt);
end;

procedure TSendeThread.Execute;
var
  Data: TDataRec;
begin
  while not Terminated do
  begin
    if Assigned(FParent) and Assigned(FParent.FParentServer) then
    begin
      Data := FDataQueue.Dequeue;
      if Length(Data.Daten) > 0 then
      begin
        Inc(Anz, Length(Data.Daten));

        if FParent.FParentServer.UseNagle then
        begin
          //TForm1(FParent.FForm).Log('01-Server(TSendeThread): UseNagle aktiv');
        end;

        if FParent.ReadingIsActiv then
        begin
          //TForm1(FParent.FForm).Log('01-Server: Lesevorgang parallel aktiv');
        end;

        {
        if Assigned(Data.Context) and Assigned(Data.Context.Connection) then
        begin
          var sw3 := TStopwatch.StartNew;
          var t3 : Int64;

          if Data.Context.Connection.Connected then
          begin
            Data.Context.Connection.IOHandler.WriteDirect(Data.Daten);

            //TForm1(FParent.FForm).Log('01-Server: Gesendet. Restanzahl: ' + FDataQueue.FQueue.Count.ToString);
          end;

          t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
          if t3 > 50 then
          begin
            //TForm1(FParent.FForm).Log('Zeitdauer Senden: [' + t3.ToString + ']');
          end;

        end;
        }
        if Assigned(FParent.LastContext) and Assigned(FParent.LastContext.Connection) then
        begin
          var sw3 := TStopwatch.StartNew;
          var t3 : Int64;

          if FParent.LastContext.Connection.Connected then
          begin
            FParent.LastContext.Connection.IOHandler.WriteDirect(Data.Daten);

            //TForm1(FParent.FForm).Log('01-Server: Gesendet. Restanzahl: ' + FDataQueue.FQueue.Count.ToString);
          end;

          t3 := sw3.ElapsedMilliseconds; //Zeitmessung stoppen
          if t3 > 50 then
          begin
            //TForm1(FParent.FForm).Log('Zeitdauer Senden: [' + t3.ToString + ']');
          end;

        end;
      end
      else
        Sleep(1);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestData: TDataRec;
  tmpInt : Integer;
begin
  if not Assigned(MyServer) then
    Exit;

  for var i := 1 to 100 do
  begin
    tmpInt := Random(60000);
    if tmpInt < 10 then
      tmpInt := 10;

    SetLength(TestData.Daten, 60000);
    FillChar(TestData.Daten[0], Length(TestData.Daten), 65);

    TestData.Context := Nil;
    if Assigned(MyServer.LastRecData.Context) then
      TestData.Context := MyServer.LastRecData.Context;

    MyServer.FSendeDataQueue.Enqueue(TestData);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;

  SL := TStringList.Create;
  Memo1.Clear;

  try
    MyServer := TMyTCPServer.Create(Self);
    MyServer.Start;

    Log('Server läuft auf Port 5000');
  except
    on E: Exception do
      Log('Fehler: ' + E.Message);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyServer.Stop;
  FreeAndNil(MyServer);
  FreeAndNil(SL);
end;

procedure TForm1.Log(aStr : String);
begin
  Exit;

  System.TMonitor.Enter(SL);
  try
    SL.Add(aStr);

    if UpdateTimer.Enabled then
      Exit;

    UpdateTimer.Enabled := True;
  finally
    System.TMonitor.Exit(SL);
  end;
end;

procedure TForm1.UpdateTimerTimer(Sender: TObject);
begin
  Exit;

  UpdateTimer.Enabled := False;

  System.TMonitor.Enter(SL);
  try
    Memo1.Lines.Text := SL.Text;
  finally
    System.TMonitor.Exit(SL);
  end;
end;

end.

Bitte mal 1:1 diesen Code testen und sagen, wo das Problem beim Receive ist. Ich habe die Funktion im Receive-Thread exakt wie von Ihnen beschrieben eingebaut. Trotzdem kommt der Server nur 5x in den Aufruf (ich weiß, weil der Buffer beim Client voll ist)

Delphi-Quellcode:

FParent.LastContext.Connection.IOHandler.WriteDirect(Data.Daten);

und der Client empfängt nichts.

[Kas Ob.]

> Please test this code 1:1 and tell me where the problem is with the receive. I've implemented the function in the receive thread exactly as you described. However, the server only calls FParent.LastContext.Connection.IOHandler.WriteDire ct(Data.Data); five times (I know because the client's buffer is full), and the client receives nothing.

Yes this one and i tested 1:1 and well... i have to few lines due to inline varibales !! my IDE doesn't support them and i don't have one super duper likes yours.

The result it is not working, server send the the client still not reading ! as it is not reading at all, and my diagnosis is still standing and right the server send and stop sending when the client is not receiving.

Now, what is the problem ?
The problem is you still missing the use of simple copy and paste, compare your pasted client and see for your self, you missed the critical protection against performing blocking recv on no fully connected socket !

So once you change this line

Delphi-Quellcode:

    if Assigned(FParent) and Assigned(FParent.FParentClient) then //

,
To this line

Delphi-Quellcode:

    if Assigned(FParent) and Assigned(FParent.FParentClient) and FParent.FParentClient.Connected then //

,
It will work like charm !

Performing recv will block forever on non ready socket (also will not receive anything), keep that in mind and you will left with 99 problem to solve.

[Kas Ob.]

Just remembered something ReadLn should be blocking too, didn't check, in theory it should and if it is then the same missing check for connected state is the root failure in your original code, this doesn't mean this demo should not be re-written, but it should be re-written with right threading handling.

[AJ_Oldendorf]

Danke Kas Ob., ich habe die Änderung

Delphi-Quellcode:

and FParent.FParentClient.Connected then

wirklich übersehen gehabt.
Mit dieser Änderung geht es!
Ich werde jetzt, nachdem die Grundarchitektur funktioniert, dies wieder in mein Hauptprogramm einpflegen (keine Angst, ohne VCL Zugriffe etc :-) ) und prüfen, ob ich damit auch die Probleme mit den Zeitverzögerungen beim Schreibbefehl habe. Das war ja eigentlich der Hauptgrund warum ich dieses Testprojekt zusammengeschustert habe

[Kas Ob.]

Zitat:

Zitat von AJ_Oldendorf (Beitrag 1547971)

Danke Kas Ob., ich habe die Änderung

Delphi-Quellcode:

and FParent.FParentClient.Connected then

wirklich übersehen gehabt.
Mit dieser Änderung geht es!
Ich werde jetzt, nachdem die Grundarchitektur funktioniert, dies wieder in mein Hauptprogramm einpflegen (keine Angst, ohne VCL Zugriffe etc :-) ) und prüfen, ob ich damit auch die Probleme mit den Zeitverzögerungen beim Schreibbefehl habe. Das war ja eigentlich der Hauptgrund warum ich dieses Testprojekt zusammengeschustert habe

Really happy for you, and good luck !

In any case if there is still a delay, then please share to figure out a delay fix.

[AJ_Oldendorf]

Da bin ich mal wieder :-)

Folgendes Phänomen:

Client baut eine Verbindung zum Server auf und der erste Empfang auf Client Seite sieht so aus:

Empfangsbuffer wird im Thread gelesen wie in den Beispielen oben drüber.
Auswertung macht ein separater Thread.
Length Eingangsbuffer am Client -> 226

Byte-Array Inhalt beim Client sieht wie folgt aus:
(0, 143, 0, 158, 0, 99, 0, 102, 0, 102, 0, 0, 0, 1, 0, 1, 0, 21, 0, 138, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

158 = 9E (=4te Byte, sagt die Paketlänge welche der Server vor dem Versand beschreibt)
Der Server schickt auch ein Paket mit 158 Länge.
Das nächste Telegram vom Server hat eine Länge von 52 Bytes. (sieht man im Wireshark auch so eintreffen)

Länge wird aber mit 226 übermittelt beim Einlesen im Thread, lauter Nullen nach den eigentlichen 158 Zeichen im Client.

Wireshark zeigt eine Length von 212 vom gesamten Paket an, in den Daten steht allerdings die richtige Anzahl von 158 Bytes. An 4ter Stelle steht die 9E -> 158 Bytes

Das nächste eintreffende Paket vom Server wird mit einer Länge von 106 Bytes im Wireshark angezeigt wobei eigentlich nur 52 Bytes mit Daten belegt sind.

Das zweite Telegramm beginnt auch nicht mit lauter Nullen sondern mit 0090 0034...

Daher meine Frage, was sind das für Nullen am Ende des ersten Paketes?