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.
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:
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:
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:
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.
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:
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:
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:
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