Your Clients list is not protected from multithreaded access. TIdTCPServer is a multi-threaded component, each client runs in its own worker thread. You need to take that into account. I suggest you get rid of your Clients list altogether and use the TIdTCPServer.Contexts property instead. Otherwise, you need to protect your Clients list, such as by changing it to a TThreadList, or at least wrapping it with a TCriticalSection (which is what TThreadList does internally).
Another problem I see is that you are setting your Client.DNS field to the wrong value, which may affect your communications depending on what you are using Client.DNS for exactly.
Try this instead:
procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
Client: TSimpleClient;
begin
Client := TSimpleClient.Create();
Client.IP := AContext.Binding.PeerIP;
Client.DNS := GStack.HostByAddress(Client.IP, AContext.Binding.IPVersion);
Client.Conectado := True;
Client.Port := AContext.Binding.Port;
Client.Name := 'Central';
Client.Thread := AContext;
AContext.Data := Client;
// this may or may not need to be Synchronized, depending on what it actually does...
if (MainEstrutura.current_central.IP = Client.IP) then
begin
MainEstrutura.current_central.Conectado := true;
MainEstrutura.envia_configuracao;
end;
end;
procedure TMainHost.idTCPServerNewDisconnect(AContext: TIdContext);
var
Client: TSimpleClient;
begin
{ Retrieve Client Record from Data pointer }
Client := TSimpleClient(AContext.Data);
{ Free the Client object }
FreeAndNil(Client);
AContext.Data := nil;
end;
procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
List: TIdContextList; // or TList in an earlier version that did not have TIdContextList yet
Context: TIdContext;
i: Integer;
Msg: String;
begin
Msg := Trim(TheMessage);
List := idTCPServerNew.Contexts.LockList;
try
for i := 0 to List.Count - 1 do
begin
Context := Context(List[i]);
if TSimpleClient(Context.Data).IP = IP then
begin
try
Context.Connection.IOHandler.WriteLn(Msg);
except
end;
Break;
end;
end;
finally
idTCPServerNew.Contexts.UnlockList;
end;
end;
With that said, if your server sends any data from inside of the OnExecute event or CommandsHandlers collection then this approach of sending a message to a client from outside of its thread is not safe, as you risk overlapping data that corrupts the communication with that client. A safer approach is to queue the outgoing data and have the OnExecute event send the data when it is safe to do so, eg:
procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
Client: TSimpleClient;
begin
Client := TSimpleClient.Create();
...
Client.Queue := TIdThreadSafeStringList.Create; // <-- add this
...
end;
procedure TMainHost.idTCPServerNewExecute(AContext: TIdContext);
var
List: TStringList;
I: Integer;
begin
Client := TSimpleClient(AContext.Data);
...
List := Client.Queue.Lock;
try
while List.Count > 0 do
begin
AContext.Connection.IOHandler.WriteLn(List[0]);
List.Delete(0);
end;
finally
Client.Queue.Unlock;
end;
...
end;
procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
List: TIdContextList; // or TList in an earlier version that did not have TIdContextList yet
Context: TIdContext;
i: Integer;
Msg: String;
begin
Msg := Trim(TheMessage);
List := idTCPServerNew.Contexts.LockList;
try
for i := 0 to List.Count - 1 do
begin
Context := Context(List[i]);
if TSimpleClient(Context.Data).IP = IP then
begin
TSimpleClient(Context.Data).Queue.Add(Msg);
Break;
end;
end;
finally
idTCPServerNew.Contexts.UnlockList;
end;
end;
Update: that being said, I would suggest deriving TSimpleClient from TIdServerContext and assign that to the server's ContextsClass property, then you don't need to use the TIdContext.Data property anymore:
type
TSimpleClient = class(TIdServerContext)
public
Queue: TIdThreadSafeStringList;
...
// or TThreadList in an earlier version that did not have TIdContextThreadList yet
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
constructor TSimpleClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
Queue := TIdThreadSafeStringList.Create;
...
end;
destructor TSimpleClient.Destroy;
begin
...
Queue.Free;
inherited;
end;
procedure TMainHost.FormCreate(Sener: TObject);
begin
// this must be assigned before the server is activated
idTCPServerNew.ContextClass := TSimpleClient;
end;
procedure TMainHost.idTCPServerNewConnect(AContext: TIdContext);
var
Client: TSimpleClient;
...
begin
Client := AContext as TSimpleClient;
// use Client as needed...
end;
procedure TMainHost.idTCPServerNewExecute(AContext: TIdContext);
var
Client: TSimpleClient;
...
begin
Client := AContext as TSimpleClient;
// use Client as needed...
end;
procedure TMainHost.DirectTCPMessage(IP: String; TheMessage: String);
var
List: TIdContextList; // or TList in an earlier version that did not have TIdContextList yet
Client: TSimpleClient;
i: Integer;
Msg: String;
begin
Msg := Trim(TheMessage);
List := idTCPServerNew.Contexts.LockList;
try
for i := 0 to List.Count - 1 do
begin
Client := TIdContext(Context(List[i])) as TSimpleClient;
if Client.IP = IP then
begin
Client.Queue.Add(Msg);
Break;
end;
end;
finally
idTCPServerNew.Contexts.UnlockList;
end;
end;
TIdTCPServerit waits for the client threads to terminate. If you do something to block one or more of those threads from terminating then the server will not be able to shut down. That happens if you synchronize with the main thread while the main thread is deactivating the server (the main thread cannot process the sync), or if you catch and discard Indy's internal exceptions instead of lettingTIdTCPServerprocess them (runaway threads), or if your event handlers are not thread-safe and cause deadlocks (like unsafe access to the UI). – Remy Lebeau