schnelle Server Client Verbindung ohne Verluste

[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 von 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

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?

[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 !

[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

[jaenicke]

Zitat von AJ_Oldendorf:

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.

[Uwe Raabe]

Zitat von 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.

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.