AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi schnelle Server Client Verbindung ohne Verluste
Thema durchsuchen
Ansicht
Themen-Optionen

schnelle Server Client Verbindung ohne Verluste

Ein Thema von AJ_Oldendorf · begonnen am 28. Mär 2025 · letzter Beitrag vom 23. Apr 2025
Antwort Antwort
Seite 7 von 8   « Erste     567 8      
Kas Ob.
Online

Registriert seit: 3. Sep 2023
436 Beiträge
 
#61

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 8. Apr 2025, 14:49
Here how you can spot it on WireShark
2025-04-08-16_47_40-_adapter-loopback-traffic-capture.jpg
Kas
  Mit Zitat antworten Zitat
Kas Ob.
Online

Registriert seit: 3. Sep 2023
436 Beiträge
 
#62

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 8. Apr 2025, 15:00
Better screenshot to point the values and the how the receiving window shrank with each recv
2025-04-08-16_47_40-_adapter-loopback-traffic-capture.jpg

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.
Kas
  Mit Zitat antworten Zitat
AJ_Oldendorf

Registriert seit: 12. Jun 2009
486 Beiträge
 
Delphi 12 Athens
 
#63

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 05:30
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 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
  Mit Zitat antworten Zitat
AJ_Oldendorf

Registriert seit: 12. Jun 2009
486 Beiträge
 
Delphi 12 Athens
 
#64

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 08:05
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
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.989 Beiträge
 
Delphi 12 Athens
 
#65

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 08:30
Im Client läuft der 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.
Sebastian Jänicke
AppCentral
  Mit Zitat antworten Zitat
AJ_Oldendorf

Registriert seit: 12. Jun 2009
486 Beiträge
 
Delphi 12 Athens
 
#66

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 09:48
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
  Mit Zitat antworten Zitat
Kas Ob.
Online

Registriert seit: 3. Sep 2023
436 Beiträge
 
#67

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 10:21
The problem is checking or polling on IOHandler.InputBuffer.Size in TReceiveThread.Execute;
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.
Kas
  Mit Zitat antworten Zitat
AJ_Oldendorf

Registriert seit: 12. Jun 2009
486 Beiträge
 
Delphi 12 Athens
 
#68

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 11:43
Danke Kas Ob. für die Korrektur des Codes allerdings funktioniert auch dieser nicht.
Hast du den Code getestet von dir?

Ein Breakpoint auf 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)
  Mit Zitat antworten Zitat
Kas Ob.
Online

Registriert seit: 3. Sep 2023
436 Beiträge
 
#69

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 13:28
Danke Kas Ob. für die Korrektur des Codes allerdings funktioniert auch dieser nicht.
Hast du den Code getestet von dir?

Ein Breakpoint auf 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.
Kas
  Mit Zitat antworten Zitat
AJ_Oldendorf

Registriert seit: 12. Jun 2009
486 Beiträge
 
Delphi 12 Athens
 
#70

AW: schnelle Server Client Verbindung ohne Verluste

  Alt 9. Apr 2025, 13:44
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 procedure TReceiveThread.Execute; bei 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) FParent.LastContext.Connection.IOHandler.WriteDirect(Data.Daten); und der Client empfängt nichts.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 7 von 8   « Erste     567 8      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:20 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz