schnelle Server Client Verbindung ohne Verluste

[jaenicke]

Wenn es so schnell sein muss, sollten die Daten sofort an einen anderen Thread zur Verarbeitung gegeben werden und dort erst die Pakete extrahiert werden. So bekomme ich eine sehr geringe Latenz. Client:

Delphi-Quellcode:

program Project204;

uses
  System.Classes, System.SysUtils, IdTCPClient, IdGlobal;

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

{ TMyTCPClient }

constructor TMyTCPClient.Create;
begin
  FClient := TIdTCPClient.Create(nil);
end;

destructor TMyTCPClient.Destroy;
begin
  Disconnect;
  FreeAndNil(FClient);
  inherited;
end;

procedure TMyTCPClient.Connect(const AHost: string; APort: Integer);
begin
  FClient.Host := AHost;
  FClient.Port := APort;
  FClient.ConnectTimeout := 5000; // 5 Sekunden Timeout
  FClient.ReadTimeout := 5000;    // 5 Sekunden Timeout für Lesevorgänge
  FClient.Connect;
  Writeln('Verbunden mit ', AHost, ':', APort);
end;

procedure TMyTCPClient.Disconnect;
begin
  if FClient.Connected then
  begin
    FClient.Disconnect;
    Writeln('Verbindung getrennt.');
  end;
end;

procedure TMyTCPClient.SendData(const Data: TIdBytes);
begin
  if FClient.Connected then
  begin
    FClient.IOHandler.Write(Data);
    Writeln(Now, 'Gesendet: ', Length(Data), ' Bytes');
  end
  else
    Writeln('Fehler: Nicht verbunden.');
end;

var
  MyClient: TMyTCPClient;
  TestData: TIdBytes;
begin
  try
    MyClient := TMyTCPClient.Create;
    try
      MyClient.Connect('127.0.0.1', 5000);

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

       for var i := 1 to 1000000 do
        MyClient.SendData(TestData);

      Readln;
      MyClient.Disconnect;
    finally
      FreeAndNil(MyClient);
    end;
  except
    on E: Exception do
      Writeln('Fehler: ', E.Message);
  end;
end.

Server:

Delphi-Quellcode:

program Project203;

uses
  System.Classes, System.SysUtils, System.SyncObjs, IdTCPServer, IdContext, IdGlobal, System.Generics.Collections;

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;
  protected
    procedure Execute; override;
  public
    constructor Create(ADataQueue: TDataQueue);
  end;

  TMyTCPServer = class
  private
    FServer: TIdTCPServer;
    FDataQueue: TDataQueue;
    FProcessingThread: TProcessingThread;
    procedure OnExecuteHandler(AContext: TIdContext);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
  end;

{ TDataQueue }

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

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

procedure TDataQueue.Enqueue(const Data: TIdBytes);
begin
  FLock.Acquire;
  try
    FQueue.Enqueue(Data);
  finally
    FLock.Release;
  end;
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;

{ TProcessingThread }

constructor TProcessingThread.Create(ADataQueue: TDataQueue);
begin
  FDataQueue := ADataQueue;
  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
      Writeln('Empfangen: ', Length(Data), ' Bytes');
    end
    else
      Sleep(1);
  end;
end;

{ TMyTCPServer }

constructor TMyTCPServer.Create;
begin
  FDataQueue := TDataQueue.Create;
  FProcessingThread := TProcessingThread.Create(FDataQueue);
  FServer := TIdTCPServer.Create(nil);
  FServer.DefaultPort := 5000;
  FServer.OnExecute := OnExecuteHandler;
end;

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

procedure TMyTCPServer.OnExecuteHandler(AContext: TIdContext);
var
  Buffer: TIdBytes;
begin
  SetLength(Buffer, 8192);
  while AContext.Connection.IOHandler.InputBuffer.Size > 0 do
  begin
    AContext.Connection.IOHandler.ReadBytes(Buffer, Length(Buffer), False);
    FDataQueue.Enqueue(Buffer);
  end;
end;

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

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

var
  MyServer: TMyTCPServer;

begin
  try
    MyServer := TMyTCPServer.Create;
    MyServer.Start;
    Writeln('Server läuft auf Port 5000. Drücke Enter zum Beenden.');
    Readln;
    MyServer.Stop;
    FreeAndNil(MyServer);
  except
    on E: Exception do
      Writeln('Fehler: ', E.Message);
  end;
end.