delphi 多端口上的 tcp 服务器在关闭时挂起

Question

我使用多端口 tcp 服务器接收一些连接

像这样

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;

一切正常但是当我关闭连接时正在接收数据

应用程序将挂起并且不再响应！

启用和禁用是这样的：

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;

如果我关闭应用程序，它也会在接收数据时再次挂起但是当发件人断开连接时关闭应用程序不会造成任何问题

我该如何解决这个问题？

Answer 1

您的 TIdTCPServer.OnExecute 处理程序正在以 线程不安全 方式使用多个变量。您没有保护它们免受同时访问它们的多个线程的影响，从而导致它们的数据出现竞争条件。

但是，更重要的是，您对 TThread.Synchronize() 的使用是 TIdTCPServer 死锁的常见原因，因为它是一个多线程组件。它的 OnConnect、OnDisconnect、OnExecute 和 OnError 事件在客户端工作线程的上下文中调用，而不是在主 UI 线程中调用。 TThread.Synchronize() 阻塞调用线程，直到主 UI 线程处理请求。停用 TIdTCPServer 会终止所有运行客户端线程并等待它们完全终止。因此，如果您在客户端线程 中调用 TThread.Synchronize() 而 主 UI 线程被阻止停用服务器，则客户端线程正在等待主 UI 线程，而主 UI 线程正在等待客户端线程 - 死锁！

你有几个选项可以解决这个问题：

避免在停用服务器时调用 TThread.Synchronize()。不过说起来容易做起来难，因为当您决定停用 TIdTCPServer 时，您可能已经处于待定 TThread.Synchronize() 状态。在决定是否调用 TThread.Synchronize() 时，这是一个竞争条件。
在单独的工作线程中停用 TIdTCPServer，让主 UI 线程自由处理 TThread.Synchronize() 和 TThread.Queue() 请求。如果您使用 TThread 进行停用，则在主 UI 线程中调用 TThread.WaitFor() 方法将在等待 Synchronize()/Queue() 请求时处理线程终止。
使用 TThread.Queue() 而不是 TThread.Synchronize()，尤其是在执行客户端线程实际上不需要等待的操作时，例如 UI 更新。

附带说明，在您的 CheckBox6Click():

你根本不应该调用 TIdTCPServer.StartListening() 或 TIdTCPServer.StopListening()。 TIdTCPServer.Active 属性 setter 在内部为您调用它们。
你也不需要调用 TIdStack.IncUsage() 或 TIdStack.DecUsage()，因为 TIdTCPServer 的构造函数和析构函数会为你调用它们。
你正在泄漏 allIpList 因为你没有 Free() 它。而且 TIdStack.AddLocalAddressesToList() 无论如何都已弃用，您应该改用 TIdStack.GetLocalAddressList()。

试试这个：

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;

delphi 多端口上的 tcp 服务器在关闭时挂起

delphi tcp server on multi port hanged on close

delphi

tcp

indy