TCP Client/Server: stabile Verbindung???

[romber]

Hallo!

Das Programm führt verschiedene Anylisen durch und schickt die Ergebnisse sofort an alle verbundene Clients. Es ist sehr wichtig, dass die Verbindung sofort wieder aufgebaut wird, falls diese aus irgendeinem Grund unterbrochen wurde. Die Code, die ich mir dafür gebastelt habe, funktioniert, es ist aber irgendwo Hacken drin. Irgendwann springt die CPU-Auslastung auf 100%, die Anzeige der verbundenen Clienten spinnt und als Folge wird das Client-Programm stumm terminiert. Zack - einfach weg, als on man das Programm geschlossen hat.

Server:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Timer1: TTimer;
    Label1: TLabel;
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TClientClass = class
  private
    PeerThread: TIdPeerThread;
end;

var
  Form1: TForm1;
  fClientList: TList;       //Liste für verbundene Client
  ListData: TStringList;    //In dieser Liste landen die Daten, die dann an die Clienten verschickt werden

implementation

{$R *.dfm}

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
  AThread.Data := TClientClass.Create();
  fClientList.Add(AThread.Data);
  TClientClass(AThread.Data).PeerThread := AThread;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fClientList := TList.Create;
  ListData := TStringList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fClientList.Free;
  ListData.Free;
end;

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
  fClientList.Delete(fClientList.IndexOf(AThread.Data));
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  i: integer;
  LastIndex: integer;
  NoData: integer;
  lCount: integer;
begin
  LastIndex := ListData.Count;
  while AThread.Connection.Connected do
  begin
     Sleep(1);
     if ListData.Count > LastIndex then
     begin
       NoData := 0;
       lCount := ListData.Count;
       for i := lCount - 1 - LastIndex downto 0 do
       AThread.Connection.WriteLn(ListData.Strings[i] + '|~|');
       LastIndex := lCount;
     end
     else                                       // Wenn die Verbidunung zu einem Client unerwartet
     begin                                      // abgebrochen wird, merkt das der Server erst, wenn
       NoData := NoData + 1;                    // er versucht, irgendwas zu schicken. Dafür ist dieses
       if NoData >= 100 then                    // Teil da.
       begin                                 
         AThread.Connection.WriteLn();
         NoData := 0;
       end;
     end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := IntToStr(fClientList.Count) + ' aktive Verbindungen';
end;

end.

Client:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls;

type
  TForm1 = class(TForm)
    cbConnect: TCheckBox;
    procedure cbConnectClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TCheckConnection = class(TThread)
  protected
    procedure Execute; override;
end;

type
  TClientTCP = class(TThread)
  constructor Create (CreateSuspended: Boolean);
  destructor Destroy; override;
 private
   TempData: string;
   CheckConnection: TCheckConnection;
 protected
   procedure Execute; override;
   procedure TCPClientStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
 public
   TCPClient: TIdTCPClient;
end;

var
  Form1: TForm1;
  TCPConnection: TClientTCP;
  CheckConnectionCounter: integer;

implementation

{$R *.dfm}

procedure TCheckConnection.Execute;
begin
  FreeOnTerminate := true;
  while not Terminated do
  begin
     CheckConnectionCounter := CheckConnectionCounter + 1;
     if CheckConnectionCounter = 5 then
     begin
        TCPConnection.TCPClient.Disconnect;
        Terminate;
     end;
     Sleep(1000);
  end;
end;

constructor TClientTCP.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := true;
end;

destructor TClientTCP.Destroy;
begin
  Sleep(1);
  TCPConnection := nil;
  if Form1.cbConnect.Checked then
  begin
    if  not Assigned(TCPConnection) then
    TCPConnection := TClientTCP.Create(false);
  end;
  if Assigned(CheckConnection) then
  CheckConnection.Terminate;
end;

procedure TClientTCP.Execute;
var
  x, Data: string;
begin
  CheckConnectionCounter := 0;
  TCPClient := TIdTCPClient.Create(nil);
  TCPClient.OnStatus := TCPClientStatus;
  TCPClient.Host := 'localhost';
  TCPClient.Port := 55595;
  try
    TCPClient.Connect;
    CheckConnection := TCheckConnection.Create(false);
    while not Terminated and TCPClient.Connected do
    begin
       CheckConnectionCounter := 0;
       x := TCPClient.ReadLn;
       Data := TempData + x;
       TempData := '';
       while pos('|~|', Data) > 0 do
       begin
         //TAnalyseData.Create(false, Copy(Data, 1, Pos('|~|', Data) - 1));
         Delete(Data, 1, Pos('|~|', Data) + 3);
       end;
       if Length(Data) > 0 then TempData := Data;
    end;
  except
  end;
  if TCPClient.Connected then
  TCPClient.Disconnect;
  TCPClient.Free;
end;

procedure TClientTCP.TCPClientStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
begin
  if AStatus = hsConnected then
  begin
    Form1.cbConnect.Caption := 'verbunden';
    exit;
  end;

  if (AStatus = hsDisconnected) or (AStatus = hsDisconnecting) then
  begin
    if Form1.cbConnect.Checked then
    Form1.cbConnect.Caption := 'Verbindung wird hergestellt...'
    else
    Form1.cbConnect.Caption := 'nicht verbunden';
    exit;
  end;
end;

procedure TForm1.cbConnectClick(Sender: TObject);
begin
  if cbConnect.Checked = true then
  begin
     cbConnect.Caption := 'Verbindung wird hergestellt...';
     if  not Assigned(TCPConnection) then
     TCPConnection := TClientTCP.Create(false);
  end
  else
  begin
    if Assigned(TCPConnection) then
    begin
       TCPConnection.Terminate;
       cbConnect.Caption := 'nicht verbunden';
    end;
  end;
end;

end.

Sicherlich mache ich etwas falsch. Wer kann mir helfen?