IdTCPServer: RSTerminateThreadTimeout (Terminate Thread ...)

Hallo!

Ich stehe wieder mal vor einem Problem bei dem ich nicht weiter komme:

Zur Vorgeschichte: Ich erstellte zurvor einen IdTCPServer und IdTCPClienten von Indy in einer eigenen Unit.
Da es da aber viele Fehler gab hab ich, um die Fehler leichter zu debuggen schnell die Unit in ein neues Formular geschrieben.

Die Indy-Komponenten sind in einer eigenen Komponente zusammengefasst.

zusammenfalten · markieren

Delphi-Quellcode:

			type

  TTCPIP = class (TComponent)  

    private               

      TCPServer : TIdTCPServer;

      TCPClient : TIdTCPClient;

      ...

    published

      constructor Create (Owner : TComponent); override;

      destructor Destroy; override;  

      procedure CreateTCPServer; 

      procedure DestroyTCPServer; 

      procedure CreateTCPClient;    

      procedure DestroyTCPClient;

      ...

Die Klasse TTCPIP stand zuvor allein da und binde ich nun mit:

zusammenfalten · markieren

Delphi-Quellcode:

			type

  TForm1 = class(TForm)

    ...

    published

      TCPConnection : TTCPIP; 

    ...

...

var

  Form1: TForm1;

in das Formular ein.

Beim Erstellen des Formulars erstelle ich auch die Komponente:

markieren

Delphi-Quellcode:

			procedure TForm1.FormCreate(Sender: TObject);

 begin    

  TCPConnection := TTCPIP.Create (Application); 

 end;

Im Constructor Create von der TTCPIP-Komponente erstelle ich Server und Client mit:

zusammenfalten · markieren

Delphi-Quellcode:

			constructor TTCPIP.Create (Owner : TComponent);

 begin

  inherited Create (Owner);

  ...                                

  CreateTCPServer;

  CreateTCPClient;

 end;

...

procedure TTCPIP.CreateTCPServer;

 begin                         

  TCPServer := TIdTCPServer.Create (Form1.TCPConnection);   // ist das Form1.TCPConnection im Create richtig?

  with TCPServer do

   begin

    OnConnect := TCPServerOnConnect; 

    ...

    OnListenException := TCPServerOnListenException;  

   end;   

  ServerConnected := false; 

 end;   

procedure TTCPIP.CreateTCPClient;

 begin                                    

  TCPClient := TIdTCPClient.Create (Form1.TCPConnection); 

  with TCPClient do

   begin

    OnConnected := TCPClientOnConnected;

    ...

    OnStatus := TCPClientOnStatus;

   end;

  ClientConnected := false;

 end;

Auf dem Form hab ich zwei Buttons, einer zum Verbinden, der andere zum Trennen.

zusammenfalten · markieren

Delphi-Quellcode:

			procedure TForm1.Button1Click(Sender: TObject);

 begin   

  with TCPConnection do

   begin

    ServerIP := '0.0.0.0';

    ...

    Timeout := 1;

    StartServer;

    ConnectToServer;

   end;    

 end;

procedure TForm1.Button2Click (Sender: TObject);

 begin      

  with TCPConnection do

   begin   

    DisconnectToServer;

    EndServer;   

   end;     

 end;

Zusätzlich zwei Memos in denen ich im einem Fehlermeldungen ausgeben lasse und im anderen "neutrale" (also auf deutsch: gute) Meldungen.
...

Beim Klick auf Button1 wird erst der Server gestartet und Anschließend der Client zum Server verbunden:

zusammenfalten · markieren

Delphi-Quellcode:

			  
procedure TTCPIP.StartServer;

var

  Binding : TIdSocketHandle;

 begin   

  if (ServerConnected) then

   begin 

    ErrorMessage := 'Server bereits gestartet';

    exit;

   end;

  try

    try 

      Binding := TCPServer.Bindings.Add;

      Binding.IP := FServerIP;

      Binding.Port := FServerPort;   

      TCPServer.Active := true;

      ServerConnected := TCPServer.Active;

    except

      on E : Exception do

       begin

        ErrorMessage := 'Fehler beim Starten des Servers: ' + E.Message;

       end;  

     end;

   finally

     Message := 'Server erfolgreich gestartet';

    end;   

  if (not (ServerConnected)) then

   begin

    ErrorMessage := 'Server nicht gestartet';

   end; 

 end;

procedure TTCPIP.ConnectToServer;

 begin    

  TCPClient.Host := FClientIP;

  TCPClient.Port := FClientPort;  

//  TCPClient.ReadTimeout := Timeout * 1000;  

  try

    try

      TCPClient.Connect (Timeout * 1000);

    except

      on E : Exception do

       begin

        ErrorMessage := 'Fehler beim Verbinden zum Server: ' + E.Message;

       end;

     end;  

  finally

    Message := 'Client verbunden';

   end;                      

  ClientConnected := TCPClient.Connected;

 end;

Bis dahin ist alles in Ordnung.

Beim Klick auf den zweiten Button wird der Client vom Server getrennt und der Server beendet:

zusammenfalten · markieren

Delphi-Quellcode:

			procedure TTCPIP.DisconnectToServer;

 begin

  if (not ClientConnected) then

   begin

    ErrorMessage := 'Client bereits getrennt';

   end; 

  try 

    try 

      TCPClient.Disconnect;

    except

      on E : Exception do

       begin

        ErrorMessage := 'Fehler beim Trennen vom Server: ' + E.Message;

       end; 

     end;     

  finally

    Message := 'Client erfolgreich getrennt';

   end;  

  ClientConnected := TCPClient.Connected; 

 end;  

procedure TTCPIP.EndServer;

 begin   

  TCPServer.Active := false;   // Und hier kracht es.

  TCPServer.Bindings.Clear;

  ServerConnected := (not (TCPServer.Active));

  if (ServerConnected) then 

   begin

    ErrorMessage := 'Server nicht beendet';

   end

  else

   begin

    Message := 'Server erfolgreich beendet';

   end; 

 end;

Beim setzen von TCPServer.Active auf false hängt das Form erst einige Sekunden und hängt sich anschließend hier (in der Unit IdTCPServer) in dieser Prozedur:

zusammenfalten · markieren

Delphi-Quellcode:

			procedure TIdTCPServer.TerminateAllThreads;

const

  LSleepTime: Integer = 250;

var

  i: Integer;

  LThreads: TList;

  LTimedOut: Boolean;

begin

  // Threads will be nil if exception happens during start up, such as trying to bind to a port

  // that is already in use.

  if Assigned(Threads) then begin

    // This will provide us with posibility to call AThread.Notification in OnDisconnect event handler

    // in order to access visual components. They can add notifications after the list has been

    // unlocked, and before/while TerminateThreads is called

    LThreads := Threads.LockList; try

      for i := 0 to LThreads.Count - 1 do begin

        with TIdPeerThread(LThreads[i]) do begin

          Connection.DisconnectSocket;

        end;

      end;

    finally Threads.UnlockList; end;

    // Must wait for all threads to terminate, as they access the server and bindings. If this

    // routine is being called from the destructor, this can cause AVs

    //

    // This method is used instead of:

    //  -Threads.WaitFor. Since they are being destroyed thread. WaitFor could AV. And Waiting for

    //   Handle produces different code for different OSs, and using common code has troubles

    //   as the handles are quite different.

    //  -Last thread signaling

    // ThreadMgr.TerminateThreads(TerminateWaitTime);

    if not TIdThreadSafeList(Threads).IsCountLessThan(1) then begin

      LTimedOut := True;

      for i := 1 to (TerminateWaitTime div LSleepTime) do begin

        Sleep(LSleepTime);

        if TIdThreadSafeList(Threads).IsCountLessThan(1) then begin

          LTimedOut := False;

          Break;

        end;

      end;

      if LTimedOut then begin      

        raise EIdTerminateThreadTimeout.Create(RSTerminateThreadTimeout);   // <-- hier

      end;

    end;

  end;

End;//TerminateAllThreads

...mit raise EIdTerminateThreadTimeout.Create(RSTerminateThread Timeout); durch die Exception aus.

Aber warum ich die Exception bekomme weiß ich nicht. Und genau dazu brauch ich Hilfe.

Daten werden bisher nicht an den Server gesendet und auch der OnExecute-Thread des Servers ist vorerst leer.

Da ich mit dem Problem bereits über eine Woche zu kämpfen hab bin ich über jede Hilfe die ich kriegen kann dankbar!
Ich denke bald der Fehler liegt beim Erstellen (Create) des Servers oder des Clienten.

Delphi-Version: Delphi 5 Enterprise
Indy-Version: 9

Vielen Dank und Gruß, Robert

IdTCPServer: RSTerminateThreadTimeout (Terminate Thread ...)

IdTCPServer: RSTerminateThreadTimeout (Terminate Thread ...)

Forumregeln