TIdTCPServer / TIdTCPClient => Ping - Pong

[Jackie1983]

Hi Data,

danke erst mal das du dir die Zeit nimmst das ganze mit mir durchzugehen.
Eventuell noch als Hinweis. Die Befehle die versendet werden sehen so aus.

Delphi-Quellcode:

  TSocketPaket = record
    //Header
    sizeGesamt : integer;
    sizeDaten : integer;
    Command : TCommand;
    //Daten
    daten : TStringlist;
  end;

function TCommandHandling.SendFrames: String;
var
  datastring,
  FFrames : string;
  size : integer;
begin
  datastring := fSocketPaket.daten.CommaText;

  //4 = Integer / Geaamtlänge
  //4 = Integer / Befehl
  //4 = Integer / Länge Daten
  //  = 12
  SetLength(FFrames,12+Length(datastring));
  ZeroMemory(Pchar(FFrames),Length(FFrames));

  //1-4  -> gesamtlänge
  PCardinal(@FFrames[1])^ := Length(fframes); //gesamtlänge
  //5-8  -> befehl
  PCardinal(@FFrames[5])^ := Integer(fSocketPaket.Command);
  //9-12 -> länge daten
  PCardinal(@FFrames[9])^ := Length(datastring);

  //13-x -> daten
  size := length(datastring);
  if datastring <> '' then
    System.Move(Pchar(datastring)^,Pointer(@FFrames[13])^,Size);

  result := FFrames;
end;

Denke werde es aber so machen wie ich hier im Beispiel gefunden habe.

Also so in der Art. Starte Kommunikation, warte auf antwort, sende Daten, warte auf Antwort, sende Daten, ...., beende Kommunikation. Warte auf Kommunikation Start...

Das ist der Server.

Delphi-Quellcode:

unit DTS_Server;

interface

uses
  Windows, Classes, IdTCPServer, SysUtils, DTS_Command, DTS_Utils,
  IdSocketHandle, SyncObjs, Contnrs;

Type
  TServerOnRead = Procedure(AThread: TIdPeerThread; Data : TCommandHandling) of object;
  TServerOnEvent = Procedure(AThread: TIdPeerThread) of object;

  TClientData = class(TObject)
  private
    fDNS         : String;                { Hostname }
    fConnected,                           { Time of connect }
    fLastAction  : TDateTime;             { Time of last transaction }
    fThread      : Pointer;               { Pointer to thread }
  public
    Property DNS : String read fDNS write FDNS;
    Property Connected : TDateTime read fConnected write fConnected;
    Property LastAction : TDateTime read fLastAction write fLastAction;
    Property Thread : Pointer read fThread write fThread;
  end;

  TDTSServer = class(TThread)
  private
    fPort : Integer;
    fClientList : TobjectList;
    fServer : TIdTCPServer;
    fOnRead : TServerOnRead;
    fOnDisconnect : TServerOnEvent;
    fBindIP : String;
    Procedure OnExecute(AThread: TIdPeerThread);
    Procedure OnConnect(AThread: TIdPeerThread);
    Procedure OnDisconnect(AThread: TIdPeerThread);
  public
    Constructor Create(Port : integer; BindIP : String = '127.0.0.1');
    Destructor Destroy; override;

    Procedure Broadcast(Data : TCommandHandling);
    Property OnClientReadData : TServerOnRead read fOnRead write fOnRead;
    Property OnClientDisconnect : TServerOnEvent read fOnDisconnect write fOnDisconnect;
  protected
    Procedure Execute; override;
    Procedure DoTerminate; override;
  end;

implementation

{ TDTSServer }

procedure TDTSServer.Broadcast(Data: TCommandHandling);
var
  i : integer;
  RecClient : TClientData;
  RecThread : TIdPeerThread;
begin
  try
    for i := 0 to fClientList.Count-1 do  // iterate through client-list
    begin
      RecClient := TClientData(fClientList.Items[i]);           // get client-object
      RecThread := RecClient.Thread;     // get client-thread out of it
      RecThread.Connection.WriteLn(Data.SendFrames);  // send the stuff
    end;
  finally
    FreeAndNil(Data);
  end;
end;

constructor TDTSServer.Create(Port: integer; BindIP : String = '127.0.0.1');
begin
  inherited Create(false);
  fPort := Port;
  fBindIP := BindIP;
end;

destructor TDTSServer.Destroy;
begin
  self.Terminate;
  self.WaitFor;

  inherited;
end;

procedure TDTSServer.DoTerminate;
begin
  inherited;

end;

procedure TDTSServer.Execute;
var
  MSG : TMsg;
  Binding : TIdSocketHandle;
begin
  inherited;

  fClientList := TObjectList.Create;

  fServer := TIdTCPServer.Create(nil);
//  fServer.TerminateWaitTime := 3000;
  fServer.Bindings.Clear;
  Binding := fServer.Bindings.Add;
  Binding.IP := fBindIP;
  Binding.Port := fPort;

  fServer.OnExecute := OnExecute;
  fServer.OnConnect := OnConnect;
  fServer.OnDisconnect := OnDisconnect;

  fServer.Active := true;

  while not Terminated do begin
    sleep(100);
  end;
//  while (GetMessage(msg, 0, 0, 0) and not Terminated) do
//    DispatchMessage(msg);

  fServer.Active := false;
  FreeAndNil(fServer);
  FreeAndNil(fClientList);
end;

procedure TDTSServer.OnConnect(AThread: TIdPeerThread);
var
  Data : TClientData;
begin
  Data := TClientData.Create;
  Data.DNS         := AThread.Connection.LocalName;
  Data.Connected   := Now;
  Data.LastAction  := Now;
  Data.Thread      := AThread;

  AThread.Data := TClientData(Data);

  fClientList.Add(Data);
end;

procedure TDTSServer.OnDisconnect(AThread: TIdPeerThread);
var
  Data : TClientData;
begin
  if(Assigned(fOnDisconnect)) then
    fOnDisconnect(AThread);

  Data := TClientData(AThread.Data);
  fClientList.Remove(Data);
  AThread.Data := nil;
end;

procedure TDTSServer.OnExecute(AThread: TIdPeerThread);
var
  msg : string;
  cmd : TCommandHandling;
begin
  AThread.Connection.ReadTimeout := 1000;
  try
    msg := AThread.Connection.ReadLn;
  except
    exit;
  end;

  cmd := TCommandHandling.Create(CMDPong);
  try
    cmd.SetFrames(msg);
    if cmd.GetCmd = CMDPing then
    begin
      cmd.SetCommand(CMDPong);
      AThread.Connection.WriteLn(cmd.SendFrames);
    end else begin
      if Assigned(fOnRead) then
        //Weiter an die eigentliche Command behandlung.
        fOnRead(AThread, cmd);
      end;
  finally
    FreeAndNil(cmd);
  end;
end;

end.

Mfg