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;