Search code examples
delphitcpindy

delphi tcp server on multi port hanged on close


i used a multi port tcp server to receive some connections

like this

procedure TForm2.IdTCPServer1Execute(AContext: TIdContext);
var
    aByte: Byte;
    i,j , tmBodyFrameLength:integer;
    myThread : tthread;
begin
    if not Assigned( allOfflineStringList ) then
    begin
        allOfflineStringList := TStringlist.Create;
    end;
    allOfflineStringList.Clear;

   case AContext.Binding.Port of
      55000: begin       {offline and image}
              AContext.Connection.IOHandler.ReadBytes(data, 1099, False);
              rowFrame :='';
              for I := 0 to length(data)-1 do
              begin
                rowFrame := rowFrame + (data[i].ToHexString);
              end;
              newFrame := copy( rowFrame , 9 , maxInt );
              allOfflineStringList.Append( newFrame );

              TThread.Synchronize (TThread.CurrentThread,
              procedure ()
              begin
                  Label985.caption := 'Offline : ' + allOfflineStringList.Count.ToString ;
                  //Memo14.Lines.Add( datetimetostr(now) +':'+ newFrame );
                  form2.AbLED601.Tag := DateTimeToUnix(now);
                  form2.AbLED601.Checked := true;
              end);
      end;

      55001: begin             {tm online}
          repeat
              aByte := AContext.Connection.IOHandler.ReadByte;
              if aByte=$C0 then
              begin
                  SDRtmOnlineRowFrame2 := SDRtmOnlineRowFrame;
                  SDRtmOnlineRowFrame := '';
                  TThread.Synchronize (TThread.CurrentThread,
                  procedure ()
                  begin
                      form2.Memo14.Lines.Add('tm:'+ SDRtmOnlineRowFrame2 );
                  end);
              end
              else
              begin
                 SDRtmOnlineRowFrame := SDRtmOnlineRowFrame + aByte.ToHexString;
              end;
          until true;
      end;

      55003: begin      {beacon online}
          repeat
              aByte := AContext.Connection.IOHandler.ReadByte;
              if aByte=$C0 then
              begin
                  SDRtmOnlineBeaconRowFrame2 := SDRtmOnlineBeaconRowFrame;
                  SDRtmOnlineBeaconRowFrame := '';
                  TThread.Synchronize (TThread.CurrentThread,
                  procedure ()
                  begin
                      form2.Memo14.Lines.Add('beacon:'+ SDRtmOnlineBeaconRowFrame2 );
                  end);
              end
              else
              begin
                 SDRtmOnlineBeaconRowFrame := SDRtmOnlineBeaconRowFrame + aByte.ToHexString;
              end;
          until true;
      end;
   end;
 end;

every thing working good but when data is receiving if i close the connection

app will hange and dont responding any more!

enable and disable is like this:

procedure TForm2.CheckBox6Click(Sender: TObject);
var
  ic:integer;
  allIpList : TStringList;
begin
   AbLED412.Checked := CheckBox6.Checked;

   if CheckBox6.Checked=true then
   begin

      IdTCPServer1.Active := False;
      IdTCPServer1.Bindings.Clear;

      with IdTCPServer1.Bindings.Add do
      begin
        //IP := '192.168.1.5';
        Port := 55000;
      end;

      with IdTCPServer1.Bindings.Add do
      begin
        //IP := '192.168.1.5';
        Port := 55001;
      end;

      with IdTCPServer1.Bindings.Add do
      begin
        //IP := '192.168.1.5';
        Port := 55003;
      end;

      IdTCPServer1.Active := True;
      IdTCPServer1.StartListening;

      TIdStack.IncUsage;
      try
        allIpList := TStringList.Create;
        GStack.AddLocalAddressesToList( allIpList );
        memo14.lines.clear;
        for ic := 0 to allIpList.Count-1 do
        begin
          memo14.lines.Add('Create tcp connection on ip : '+allIpList[ic]+' and port : 55000');
          memo14.lines.Add('Create tcp connection on ip : '+allIpList[ic]+' and port : 55001');
          memo14.lines.Add('Create tcp connection on ip : '+allIpList[ic]+' and port : 55003');
        end;
      finally
        TIdStack.DecUsage;
      end;


   end
   else
   begin
        IdTCPServer1.StopListening;
        IdTCPServer1.Active := False;
        IdTCPServer1.Bindings.Clear;
        memo14.lines.clear;
   end;

end;

also when data is receiving if i close the app it hanged again but when sender disconnected closing the app dont make any problem

how can i fix this?


Solution

  • Your TIdTCPServer.OnExecute handler is using multiple variables in a thread-unsafe manner. You are not protecting them from multiple threads accessing them at the same time, thus causing race conditions on their data.

    But, more importantly, your use of TThread.Synchronize() is a common cause of deadlock for TIdTCPServer because it is a multi-threaded component. Its OnConnect, OnDisconnect, OnExecute, and OnError events are called in the context of client worker threads, not in the main UI thread. TThread.Synchronize() blocks the calling thread until the main UI thread processes the request. Deactivating TIdTCPServer terminates all running client threads and waits for them to fully terminate. So, if you call TThread.Synchronize() in a client thread while the main UI thread is blocked deactivating the server, then the client thread is waiting on the main UI thread while the main UI thread is waiting on the client thread - deadlock!

    You have a few options to solve this:

    • avoid calling TThread.Synchronize() while deactivating the server. Easier said than done though, as you might already be in a pending TThread.Synchronize() by the time you decide to deactivate TIdTCPServer. And it is a race condition when making the decision whether to call TThread.Synchronize() or not.

    • deactivate TIdTCPServer in a separate worker thread, leave the main UI thread free to process TThread.Synchronize() and TThread.Queue() requests. If you use a TThread for the deactivation, calling the TThread.WaitFor() method in the main UI thread will process Synchronize()/Queue() requests while it is waiting for the thread to terminate.

    • Use TThread.Queue() instead of TThread.Synchronize(), especially when performing actions that your client threads don't actually need to wait on, such as UI updates.


    On a side note, in your CheckBox6Click():

    • you should not be calling TIdTCPServer.StartListening() or TIdTCPServer.StopListening() at all. The TIdTCPServer.Active property setter calls them internally for you.

    • you don't need to call TIdStack.IncUsage() or TIdStack.DecUsage() either, as TIdTCPServer's constructor and destructor call them for you.

    • you are leaking allIpList as you don't Free() it. And TIdStack.AddLocalAddressesToList() is deprecated anyway, you should be using TIdStack.GetLocalAddressList() instead.

    Try this:

    procedure TForm2.CheckBox6Click(Sender: TObject);
    var
      ic: integer;
      allIpList : TIdStackLocalAddressList;
    begin
      AbLED412.Checked := CheckBox6.Checked;
    
      if CheckBox6.Checked then
      begin
        IdTCPServer1.Active := False;
        IdTCPServer1.Bindings.Clear;
    
        with IdTCPServer1.Bindings.Add do
        begin
          //IP := '192.168.1.5';
          Port := 55000;
        end;
    
        with IdTCPServer1.Bindings.Add do
        begin
          //IP := '192.168.1.5';
          Port := 55001;
        end;
    
        with IdTCPServer1.Bindings.Add do
        begin
          //IP := '192.168.1.5';
          Port := 55003;
        end;
    
        IdTCPServer1.Active := True;
    
        allIpList := TIdStackLocalAddressList.Create;
        try
          GStack.GetLocalAddressesList( allIpList );
          Memo14.Lines.Clear;
          {
          for ic := 0 to IdTCPServer1.Bindings.Count-1 do
          begin
            Memo14.Lines.Add('Create tcp connection on ip : ' + IdTCPServer1.Bindings[ic].IP + ' and port : ' + IntToStr(IdTCPServer1.Bindings[ic].Port));
          end;
          }
          for ic := 0 to allIpList.Count-1 do
          begin
            if allIpList[ic].IPVersion = ID_DEFAULT_IP_VERSION then
            begin
              Memo14.Lines.Add('Create tcp connection on ip : ' + allIpList[ic].IPAddress + ' and port : 55000');
              Memo14.Lines.Add('Create tcp connection on ip : ' + allIpList[ic].IPAddress + ' and port : 55001');
              Memo14.Lines.Add('Create tcp connection on ip : ' + allIpList[ic].IPAddress + ' and port : 55003');
            end;
          end;
        finally
          allIpList.Free;
        end;
      end
      else
      begin
        IdTCPServer1.Active := False;
        IdTCPServer1.Bindings.Clear;
        Memo14.Lines.Clear;
      end;
    end;