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

Question

I have adapted the following code from another post on this website, but it still seems to freeze. I must be able to turn off or disconnect the server even if there are clients connected. I will wait till they finish sending messages but if I start the server, connect to it from a client, I still can't shut down the server without freezing. I then have to shut off with Windows Task Manager.

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;

Additonal information...

I use the following code to connect to the server. When it connects the server sends back a message that there was a connection.

Client Connect To Server

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 on server

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;

The combination of these 2 procedures will cause the server to freeze when I attempt to close the server program if I do not shut down the client first. I apologize I am too new to Indy to see what the issue is or how to do the thread work to solve the problem. I was hoping you would see my beginners error in one of the 2 connection procedures.

Here is the OnExecute code:

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;

Answer 1

Your with statement is calling Contexts.LockList() and then your loop is calling Contexts.LockList() again, but you are only calling Contexts.UnlockList() once after the loop has completed. As such, the Contexts list is still locked, and any further access by any other threads will deadlock indefinitely, including the client threads when they try to remove themselves from the Contexts list, which in turn will deadlock the Active property setter since it waits for all of the client thread to terminate.

In your loop, replace PantherIdTCPServer.Contexts.LockList.Count with simply Count since the with is acting on the TList that LockList() returned:

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;

In fact, all of the code you have show is completely redundant and should be removed, this is all you need:

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

It already does all of the hard work of disconnecting active clients, clearing the Contexts list, and shutting down the server. You don't need to do that stuff manually at all.