Delphi XE2 / Indy TIdTCPServer / "Connection reset by peer" -

i'm 1 problem using indy in delphi xe2 send tcp messages using tidtcpserver.

for exemple: have 2 devices , i'll go communicate device 1. when send messages device 1, messages send fine. without close program, when send messages device 2, delphi returns "connection reset peer".

below code:

procedure tmainhost.idtcpservernewconnect(acontext: tidcontext); var   client: tsimpleclient; begin   sleep(1000);   client := tsimpleclient.create();    client.dns := acontext.connection.socket.host;   client.conectado := true;   client.port := idtcpservernew.defaultport;   client.name := 'central';   client.listlink := clients.count;   client.thread := acontext;   client.ip := acontext.connection.socket.binding.peerip;    acontext.data := client;    clients.add(client);   sleep(500);    if (mainestrutura.current_central.ip = client.ip)   begin     mainestrutura.current_central.conectado := true;     mainestrutura.envia_configuracao;   end;  end;  procedure tmainhost.idtcpservernewdisconnect(acontext: tidcontext); var   client: tsimpleclient; begin   { retrieve client record data pointer }   client := pointer(acontext.data);   { remove client clients tlist }   clients.remove(client);   { free client object }   freeandnil(client);   acontext.data := nil;  end; 

to send messages devices:

procedure tmainhost.directtcpmessage(ip: string; themessage: string); var   client: tsimpleclient;   i: integer;   list: tlist;   msg: string; begin    msg := trim(themessage);    := 0 clients.count - 1   begin      client := tsimpleclient(clients.items[i]);      if tidcontext(client.thread).connection.socket.binding.peerip = ip     begin        tidcontext(client.thread).connection.socket.writeln(msg);      end;    end; end; 

and have problem.

when set active := false on tidtcpserver component, application crashes. thanks!

your clients list not protected multithreaded access. tidtcpserver multi-threaded component, each client runs in own worker thread. need take account. suggest rid of clients list altogether , use tidtcpserver.contexts property instead. otherwise, need protect clients list, such changing tthreadlist, or @ least wrapping tcriticalsection (which tthreadlist internally).

another problem see setting client.dns field wrong value, may affect communications depending on using client.dns exactly.

try 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;    // may or may not need synchronized, depending on does...   if (mainestrutura.current_central.ip = client.ip)   begin     mainestrutura.current_central.conectado := true;     mainestrutura.envia_configuracao;   end; end;  procedure tmainhost.idtcpservernewdisconnect(acontext: tidcontext); var   client: tsimpleclient; begin   { retrieve client record data pointer }   client := tsimpleclient(acontext.data);   { free client object }   freeandnil(client);   acontext.data := nil;     end; 

procedure tmainhost.directtcpmessage(ip: string; themessage: string); var   list: tidcontextlist; // or tlist in earlier version did not have tidcontextlist yet   context: tidcontext;   i: integer;   msg: string; begin   msg := trim(themessage);    list := idtcpservernew.contexts.locklist;   try     := 0 list.count - 1     begin       context := context(list[i]);       if tsimpleclient(context.data).ip = ip       begin         try           context.connection.iohandler.writeln(msg);         except         end;         break;       end;     end;       idtcpservernew.contexts.unlocklist;   end; end; 

with said, if server sends data inside of onexecute event or commandshandlers collection approach of sending message client outside of thread not safe, risk overlapping data corrupts communication client. safer approach queue outgoing data , have onexecute event send data when safe so, eg:

procedure tmainhost.idtcpservernewconnect(acontext: tidcontext); var   client: tsimpleclient; begin   client := tsimpleclient.create();   ...   client.queue := tidthreadsafestringlist.create; // <-- add   ... 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     begin       acontext.connection.iohandler.writeln(list[0]);       list.delete(0);     end;       client.queue.unlock;   end;   ... end; 

procedure tmainhost.directtcpmessage(ip: string; themessage: string); var   list: tidcontextlist; // or tlist in earlier version did not have tidcontextlist yet   context: tidcontext;   i: integer;   msg: string; begin   msg := trim(themessage);    list := idtcpservernew.contexts.locklist;   try     := 0 list.count - 1     begin       context := context(list[i]);       if tsimpleclient(context.data).ip = ip       begin         tsimpleclient(context.data).queue.add(msg);         break;       end;     end;       idtcpservernew.contexts.unlocklist;   end; end; 

update: being said, suggest deriving tsimpleclient tidservercontext , assign server's contextsclass property, don't need use tidcontext.data property anymore:

type   tsimpleclient = class(tidservercontext)   public     queue: tidthreadsafestringlist;     ...     // or tthreadlist in earlier version 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   // must assigned before server activated   idtcpservernew.contextclass := tsimpleclient; end;  procedure tmainhost.idtcpservernewconnect(acontext: tidcontext); var   client: tsimpleclient;   ...  begin   client := acontext tsimpleclient;   // use client needed... end;  procedure tmainhost.idtcpservernewexecute(acontext: tidcontext); var   client: tsimpleclient;   ... begin   client := acontext tsimpleclient;   // use client needed... end;  procedure tmainhost.directtcpmessage(ip: string; themessage: string); var   list: tidcontextlist; // or tlist in earlier version did not have tidcontextlist yet   client: tsimpleclient;   i: integer;   msg: string; begin   msg := trim(themessage);    list := idtcpservernew.contexts.locklist;   try     := 0 list.count - 1     begin       client := tidcontext(context(list[i])) tsimpleclient;       if client.ip = ip       begin         client.queue.add(msg);         break;       end;     end;       idtcpservernew.contexts.unlocklist;   end; end;