I started playing with Indy 10 (from Delphi XE3) and TCP connections recently. For now, I am trying to create a simple server application to check clients status. But when I try to deactivate TCPServer with some client already connected, clients do get disconnected but TCPServer stops answering.
I read somewhere that TCPServer should handle client's disconnection without problems. Must I add some code on OnExecute event to solve this problem?
Here is the code:
procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
If (not TCPServer.Active) Then
Try
TCPServer.Bindings.Clear;
With TCPServer.Bindings.Add Do
Begin
IP := '192.168.1.11';
Port := StrToInt(edtPort.Text);
end;
TCPServer.Active := True;
Except
On E:Exception Do ShowMessage(E.Message);
End
end;
procedure TfrmMain.btnDisconnectClick(Sender: TObject);
begin
If (TCPServer.Active) Then
Try
TCPServer.Active := False;
Except
On E:Exception Do ShowMessage(E.Message);
End
end;
procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
IdStackWin: TIdStackWindows;
begin
IdStackWin := TIdStackWindows.Create;
With IdStackWin Do
Try
memLog.Lines.Add('Connected - ' + HostByAddress(AContext.Binding.PeerIP) + ' (' + AContext.Binding.PeerIP + ')');
Finally
IdStackWin.Free;
end;
end;
procedure TfrmMain.TCPServerDisconnect(AContext: TIdContext);
var
IdStackWin: TIdStackWindows;
begin
IdStackWin := TIdStackWindows.Create;
With IdStackWin Do
Try
memLog.Lines.Add('Disconnected - ' + HostByAddress(AContext.Binding.PeerIP) + ' (' + AContext.Binding.PeerIP + ')');
Finally
IdStackWin.Free;
end;
end;
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
begin
Application.ProcessMessages;
end;
Thanks!
You are making a few mistakes.
DO NOT instantiate a TIdStack
class directly. Indy instantiates one for you while any Indy socket component is alive. If you need to access the socket stack, use the global GStack
object pointer, eg:
GStack.HostByAddress(AContext.Binding.PeerIP)
In the rare case when you need to access GStack
when no Indy component is alive, you can wrap your code with TIdStack.IncUsage()
and TIdStack.DecUsage()
method calls to ensure GStack
is available.
TIdTCPServer
is a multi-threaded component. Listening sockets and client sockets run in worker threads. The OnConnect
, OnDisconnect
, OnExecute
, OnException
, and OnListenException
events are fired in the context of those worker threads, NOT in the context of the main UI thread. As such, you MUST synchronize with the main thread in order to access VCL/FMX UI controls safely, or else bad things happen, including deadlocks amongst other things. You can use Indy's TIdSync
(synchronous) or TIdNotify
class (asynchronous) class, or the static version of the TThread.Synchronize()
(synchronous) or TThread.Queue()
(asynchronous) method, to sync with the main thread when needed. Or any other inter-thread sync mechanism of your choosing. VCL/FMX UI controls MUST be accessed only in the context of the main thread.
A word of warning: while deactivating TIdTCPServer
from the main thread, DO NOT use a synchronous sync, that is a guaranteed deadlock. Either use an asynchronous sync, or deactivate the server from another thread (not a server thread, though) so the main thread is free to process syncs normally.
Application.ProcessMessages()
should never be called outside of the main UI thread. There is no need to ever call it from the TIdTCPServer
events.
Try this instead:
procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
if not TCPServer.Active then
begin
TCPServer.Bindings.Clear;
with TCPServer.Bindings.Add do
Begin
IP := '192.168.1.11';
Port := StrToInt(edtPort.Text);
end;
TCPServer.Active := True;
end;
end;
procedure TfrmMain.btnDisconnectClick(Sender: TObject);
begin
TCPServer.Active := False;
end;
procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
Msg: string;
begin
Msg := 'Connected - ' + GStack.HostByAddress(AContext.Binding.PeerIP) + ' (' + AContext.Binding.PeerIP + ')';
TThread.Queue(nil,
procedure
begin
memLog.Lines.Add(Msg);
end
);
end;
procedure TfrmMain.TCPServerDisconnect(AContext: TIdContext);
var
Msg: string;
begin
Msg := 'Disconnected - ' + GStack.HostByAddress(AContext.Binding.PeerIP) + ' (' + AContext.Binding.PeerIP + ')';
TThread.Queue(nil,
procedure
begin
memLog.Lines.Add(Msg);
end
);
end;
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
begin
// your communications logic here
end;