Delphi XE3,Indy TCP 服务器。关闭服务器

Delphi XE3, Indy TCP Server. Shut down server

我从本网站的另一个post改编了以下代码,但它似乎仍然卡住了。即使有客户端连接,我也必须能够关闭或断开服务器。我会等到他们发送完消息,但如果我启动服务器,从客户端连接到它,我仍然无法在不冻结的情况下关闭服务器。然后我必须关闭 Windows 任务管理器。

procedure TTasksForm.ShutDownPantherServer;
var i : integer ;
    Context: TidContext;
begin

  if PantherIdTCPServer.Active = True then
    with PantherIdTCPServer.Contexts.LockList do
    try

      for i := (PantherIdTCPServer.Contexts.LockList.Count - 1) downto 0 do
      begin

        Context := Items[i] ;

        if Context = nil then
          Continue;
        Context.Connection.IOHandler.WriteBufferClear;
        Context.Connection.IOHandler.InputBuffer.Clear;
        Context.Connection.IOHandler.Close;

        if Context.Connection.Connected then
          Context.Connection.Disconnect;

      end;

    finally
      PantherIdTCPServer.Contexts.UnLockList ;
    end ;

  if PantherIdTCPServer.Active = True then
    PantherIdTCPServer.Active := False ;

end;

补充信息...

我使用以下代码连接到服务器。当它连接时,服务器发回一条消息,表明已建立连接。

客户端连接到服务器

procedure TPantherSimulatorForm.ConnectToServer ;
var MsgIn : String ;
begin

  PantherIdTCPClient.Host := IPAddressEdit.Text ;
  PantherIdTCPClient.Port := StrToInt(PortEdit.Text) ;

  PantherIdTCPClient.Connect;

  MsgIn := PantherIdTCPClient.IOHandler.ReadLn();

  TThread.Synchronize(nil,
    procedure
    begin

      ClientTrafficMemo.Clear ;
      ClientTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd    hh:nn:ss.zzz', now ) +
'  ' + MsgIn) ;
    end ) ;

end;

服务器上的 OnConnect

procedure TTasksForm.PantherIdTCPServerConnect(AContext: TIdContext);
begin

  AContext.Connection.IOHandler.DefStringEncoding := Indy8BitEncoding ;

  TThread.Synchronize(nil,
    procedure
    begin
      ServerTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
'  OnConnect') ;
end );

  // connected message
  AContext.Connection.IOHandler.WriteLn('Connected');

end;

如果我不先关闭客户端,当我尝试关闭服务器程序时,这两个过程的组合将导致服务器冻结。抱歉,我对 Indy 太陌生了,看不出问题是什么或如何进行线程工作来解决问题。我希望您能在 2 个连接过程之一中看到我的初学者错误。

这是 OnExecute 代码:

procedure TForm2.PantherIdTCPServerExecute(AContext: TIdContext);
begin
  Sleep(1000) ;

  TThread.Queue(nil,
    procedure
    begin
        ServerTrafficMemo.Lines.Add(FormatDateTime( 'yyyy-mm-dd hh:nn:ss.zzz', now ) +
'  OnExecute') ;
    end ) ;

end;

您的 with 语句正在调用 Contexts.LockList() 然后您的循环再次调用 Contexts.LockList(),但您只在循环完成后调用 Contexts.UnlockList() 一次。因此,Contexts 列表仍然被锁定,任何其他线程的任何进一步访问都将无限期地死锁,包括客户端线程,当它们试图将自己从 Contexts 列表中删除时,这反过来会死锁Active 属性 setter 因为它等待所有客户端线程终止。

在您的循环中,将 PantherIdTCPServer.Contexts.LockList.Count 替换为简单的 Count,因为 with 作用于 LockList() 返回的 TList

procedure TTasksForm.ShutDownPantherServer;
var
  i : integer ;
  Context: TidContext;
begin
  if PantherIdTCPServer.Active = True then
    with PantherIdTCPServer.Contexts.LockList do
    try
      // HERE!!!
      for i := ({PantherIdTCPServer.Contexts.LockList.}Count - 1) downto 0 do
      begin

        Context := Items[i] ;

        if Context = nil then
          Continue;
        Context.Connection.IOHandler.WriteBufferClear;
        Context.Connection.IOHandler.InputBuffer.Clear;
        Context.Connection.IOHandler.Close;

        if Context.Connection.Connected then
          Context.Connection.Disconnect;

      end;

    finally
      PantherIdTCPServer.Contexts.UnLockList ;
    end ;

  if PantherIdTCPServer.Active = True then
    PantherIdTCPServer.Active := False ;

end;

事实上,您展示的所有代码都是完全多余的,应该删除,这就是您所需要的:

procedure TTasksForm.ShutDownPantherServer;
begin
  PantherIdTCPServer.Active := False;
end;

它已经完成了断开活动客户端、清除 Contexts 列表和关闭服务器的所有艰苦工作。您根本不需要手动执行这些操作。