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

我已经从这个网站的另一篇文章中改编了下面的代码，但它似乎仍然冻结了。我必须能够关闭或断开服务器，即使有客户端连接。我会等到他们发送完消息，但如果我启动服务器，从客户端连接到服务器，我仍然无法在不冻结的情况下关闭服务器。然后我必须关闭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来说太新了，无法了解问题是什么，也无法了解如何通过线程工作来解决问题。我希望您能在两个连接过程中的一个过程中看到我的初学者错误

以下是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（）

。因此，

上下文

列表仍然被锁定，任何其他线程的任何进一步访问都将无限期地死锁，包括客户端线程在尝试从

上下文

列表中删除自己时的死锁，这反过来将使

活动的

属性设置程序死锁，因为它等待所有客户端线程终止

在您的循环中，将

PantherIdTCPServer.context.LockList.Count

替换为

Count

，因为

with

作用于

TList

，而

LockList（）

返回：

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;

---

它已经完成了断开活动客户端连接、清除

上下文

列表以及关闭服务器的所有艰苦工作。您根本不需要手动执行这些操作。

您的

with

语句正在调用

context.LockList（）

，然后您的循环再次调用

context.LockList（）

，但您只在循环完成后调用一次

context.UnlockList（）

。因此，

上下文

列表仍然被锁定，任何其他线程的任何进一步访问都将无限期地死锁，包括客户端线程在尝试从

上下文

列表中删除自己时的死锁，这反过来将使

活动的

属性设置程序死锁，因为它等待所有客户端线程终止

在您的循环中，将

PantherIdTCPServer.context.LockList.Count

替换为

Count

，因为

with

作用于

TList

，而

LockList（）

返回：

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;

---

它已经完成了断开活动客户端连接、清除

上下文

列表以及关闭服务器的所有艰苦工作。您根本不需要手动执行这些操作。

根据您的另一篇文章，我已经尝试过了，但是如果客户机已经连接到服务器，并且我执行了PantherIdTCPServer.Active:=False，那么我会尝试关闭程序冻结且不会关闭的窗体。如果关闭已连接的客户端程序，然后关闭服务器，我可以关闭表单而不冻结。如果客户端已经连接并且仍然连接，我关闭服务器并关闭它冻结的表单。我在服务器程序上没有OnClose或OnCloseQuery事件。它似乎会冻结，直到我断开客户端与客户端的连接。您遇到了死锁问题，例如，当客户端执行与主线程同步的操作时，您正在从主线程停用服务器。客户端将被阻止在主线程上等待，而主线程将被阻止在客户端上等待。您在问题中显示的代码也存在同样的问题。因此，在主线程中停用服务器时，不要与主线程同步，或者从单独的工作线程停用服务器，以便主线程不会被阻止。如果我仅为每台服务器分配一个客户端，因为客户端是在工作站上运行的医疗设备，则正在同步问题。只是好奇？是的，这是个问题

TIdTCPServer

是一个多线程组件，每个侦听端口在其自己的线程中运行，每个连接的客户端在其自己的线程中运行。如果每个客户端需要访问其他线程（包括主线程）中的内容，则需要进行适当的同步。在停用期间，它可以冻结的唯一方法是在您自己的代码中死锁服务器线程，以便它们无法正确终止。当主线程忙于停用服务器时，Suh将与主线程同步。您负责编写线程安全事件处理程序代码。如果您在执行此操作时遇到问题，请编辑您的问题以包含OnExecute代码。到目前为止，代码中唯一可能出现的死锁是OnConnect中的sync。尝试改用

TThread.Queue（）

，这不会阻塞。我已经根据您的另一篇文章尝试过了，但是如果客户端已经连接到服务器，并且如果我使用PantherIdTCPServer.Active:=False，那么我会尝试关闭程序冻结且不会关闭的窗体。如果关闭已连接的客户端程序，然后关闭服务器，我可以关闭表单而不冻结。如果客户端已经连接并且仍然连接，我关闭服务器并关闭它冻结的表单。我在服务器程序上没有OnClose或OnCloseQuery事件。在我断开客户端之前，它似乎会冻结