Delphi XE2 Indy 10 TIdCmdTCPServer 冻结应用答案

【问题标题】：Delphi XE2 Indy 10 TIdCmdTCPServer freezing applicationDelphi XE2 Indy 10 TIdCmdTCPServer 冻结应用
【发布时间】：2012-02-04 09:48:57
【问题描述】：

我刚刚开始学习如何在 Delphi XE2 中使用 Indy 10 组件。我从一个将使用命令套接字（TIdCmdTCPServer 和TIdCmdTCPClient）的项目开始。我已经完成了所有设置并且客户端连接到服务器，但是在客户端连接后，服务器发送给客户端的任何命令都会冻结服务器应用程序，直到它最终崩溃并关闭（在深度冻结之后）。

项目设置

设置非常简单；有一个小型服务器应用程序和一个小型客户端应用程序，每个应用程序都有其对应的 Indy 命令 tcp 套接字组件。客户端上只有一个命令处理程序。

服务器应用

在服务器上，我有一个非常简单的上下文 type TCli = class(TIdServerContext) 包装器，它只包含一个公共属性（继承实际上是 Indy 的要求）。

客户端应用

另一方面，客户端工作得很好。它从服务器接收命令并做它的事情。客户端有一个计时器，如果它尚未连接，它会自动连接。当前设置为在应用启动 1 秒后尝试连接，如果尚未连接，则每 10 秒继续尝试。

问题详情

我能够成功地从服务器向客户端发送一两个命令（客户端响应正确），但服务器在发送命令后冻结了几秒钟。我在服务器上有OnConnect、OnDisconnect、OnContextCreated 和OnException 的事件处理程序，它们所做的只是发布日志或在列表视图中处理连接/断开连接对象。

屏幕截图

最后，当客户端应用程序优雅地关闭时，服务器也会优雅地脱离其冻结状态。但是，如果客户端被强制关闭，那么服务器也被强制关闭。这就是我看到的模式。它使用PostLog(const S: String) 发布到日志事件，该事件只是将短消息附加到 TMemo。

我做过两个项目，都遇到了问题。我已经准备了一个示例项目...

服务器代码（uServer.pas和uServer.dfm）

unit uServer;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdBaseComponent, IdComponent,
  IdCustomTCPServer, IdTCPServer, IdCmdTCPServer, Vcl.StdCtrls, Vcl.Buttons,
  Vcl.ComCtrls;

type
  TCli = class(TIdServerContext)
  private
    function GetIP: String;
  public
    property IP: String read GetIP;
    procedure DoTest;
  end;

  TForm3 = class(TForm)
    Svr: TIdCmdTCPServer;
    Lst: TListView;
    Log: TMemo;
    cmdDoCmdTest: TBitBtn;
    procedure cmdDoCmdTestClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure SvrConnect(AContext: TIdContext);
    procedure SvrContextCreated(AContext: TIdContext);
    procedure SvrDisconnect(AContext: TIdContext);
    procedure SvrException(AContext: TIdContext; AException: Exception);
  private
  public
    procedure PostLog(const S: String);
    function NewContext(AContext: TIdContext): TCli;
    procedure DelContext(AContext: TIdContext);
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

{ TCli }

procedure TCli.DoTest;
begin
  Connection.SendCmd('DoCmdTest');
end;

function TCli.GetIP: String;
begin
  Result:= Binding.PeerIP;
end;

{ TForm3 }

procedure TForm3.PostLog(const S: String);
begin
  Log.Lines.Append(S);
end;

procedure TForm3.SvrConnect(AContext: TIdContext);
var
  C: TCli;
begin
  C:= TCli(AContext);
  PostLog(C.IP+': Connected');
end;

procedure TForm3.SvrContextCreated(AContext: TIdContext);
var
  C: TCli;
begin
  C:= NewContext(AContext);
  PostLog(C.IP+': Context Created');
end;

procedure TForm3.SvrDisconnect(AContext: TIdContext);
var
  C: TCli;
begin
  C:= TCli(AContext);
  PostLog(C.IP+': Disconnected');
  DelContext(AContext);
end;

procedure TForm3.SvrException(AContext: TIdContext; AException: Exception);
var
  C: TCli;
begin
  C:= TCli(AContext);
  PostLog(C.IP+': Exception: '+AException.Message);
end;

procedure TForm3.cmdDoCmdTestClick(Sender: TObject);
var
  X: Integer;
  C: TCli;
  I: TListItem;
begin
  for X := 0 to Lst.Items.Count - 1 do begin
    I:= Lst.Items[X];
    C:= TCli(I.Data);
    C.DoTest;
  end;
end;

procedure TForm3.DelContext(AContext: TIdContext);
var
  I: TListItem;
  X: Integer;
begin
  for X := 0 to Lst.Items.Count - 1 do begin
    I:= Lst.Items[X];
    if I.Data = TCli(AContext) then begin
      Lst.Items.Delete(X);
      Break;
    end;
  end;
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Svr.Active:= False;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  Svr.Active:= True;
end;

function TForm3.NewContext(AContext: TIdContext): TCli;
var
  I: TListItem;
begin
  Result:= TCli(AContext);
  I:= Lst.Items.Add;
  I.Caption:= Result.IP;
  I.Data:= Result;
end;

end.

//////// DFM ////////

object Form3: TForm3
  Left = 315
  Top = 113
  Caption = 'Indy 10 Command TCP Server'
  ClientHeight = 308
  ClientWidth = 529
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  DesignSize = (
    529
    308)
  PixelsPerInch = 96
  TextHeight = 13
  object Lst: TListView
    Left = 336
    Top = 8
    Width = 185
    Height = 292
    Anchors = [akTop, akRight, akBottom]
    Columns = <
      item
        AutoSize = True
      end>
    TabOrder = 0
    ViewStyle = vsReport
    ExplicitLeft = 333
    ExplicitHeight = 288
  end
  object Log: TMemo
    Left = 8
    Top = 56
    Width = 316
    Height = 244
    Anchors = [akLeft, akTop, akRight, akBottom]
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
    ScrollBars = ssVertical
    TabOrder = 1
  end
  object cmdDoCmdTest: TBitBtn
    Left = 8
    Top = 8
    Width = 217
    Height = 42
    Caption = 'Send Test Command'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 2
    OnClick = cmdDoCmdTestClick
  end
  object Svr: TIdCmdTCPServer
    Bindings = <>
    DefaultPort = 8664
    MaxConnections = 100
    OnContextCreated = SvrContextCreated
    OnConnect = SvrConnect
    OnDisconnect = SvrDisconnect
    OnException = SvrException
    CommandHandlers = <>
    ExceptionReply.Code = '500'
    ExceptionReply.Text.Strings = (
      'Unknown Internal Error')
    Greeting.Code = '200'
    Greeting.Text.Strings = (
      'Welcome')
    HelpReply.Code = '100'
    HelpReply.Text.Strings = (
      'Help follows')
    MaxConnectionReply.Code = '300'
    MaxConnectionReply.Text.Strings = (
      'Too many connections. Try again later.')
    ReplyTexts = <>
    ReplyUnknownCommand.Code = '400'
    ReplyUnknownCommand.Text.Strings = (
      'Unknown Command')
    Left = 288
    Top = 8
  end
end

客户端代码（uClient.pas和uClient.dfm）

unit uClient;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls,
  IdContext, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdCmdTCPClient, IdCommandHandlers, Vcl.StdCtrls;

const                             // --- Change accordingly ---
  TMR_INT = 10000;                //how often to check for connection
  SVR_IP =  '192.168.4.100';      //Server IP Address
  SVR_PORT = 8664;                //Server Port

type
  TForm4 = class(TForm)
    Tmr: TTimer;
    Cli: TIdCmdTCPClient;
    Log: TMemo;
    procedure CliCommandHandlers0Command(ASender: TIdCommand);
    procedure TmrTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CliConnected(Sender: TObject);
    procedure CliDisconnected(Sender: TObject);
  private
    procedure PostLog(const S: String);
  public
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.PostLog(const S: String);
begin
  Log.Lines.Append(S);
end;

procedure TForm4.CliCommandHandlers0Command(ASender: TIdCommand);
begin
  PostLog('Received command successfully');
end;

procedure TForm4.CliConnected(Sender: TObject);
begin
  PostLog('Connected to Server');
end;

procedure TForm4.CliDisconnected(Sender: TObject);
begin
  PostLog('Disconnected from Server');
end;

procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Cli.Disconnect;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  Tmr.Enabled:= True;
end;

procedure TForm4.TmrTimer(Sender: TObject);
begin
  if Tmr.Interval <> TMR_INT then
    Tmr.Interval:= TMR_INT;
  if not Cli.Connected then begin
    try
      Cli.Host:= SVR_IP;
      Cli.Port:= SVR_PORT;
      Cli.Connect;
    except
      on e: exception do begin
        Cli.Disconnect;
      end;
    end;
  end;
end;

end.

//////// DFM ////////

object Form4: TForm4
  Left = 331
  Top = 570
  Caption = 'Indy 10 Command TCP Client'
  ClientHeight = 317
  ClientWidth = 305
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  DesignSize = (
    305
    317)
  PixelsPerInch = 96
  TextHeight = 13
  object Log: TMemo
    Left = 8
    Top = 56
    Width = 289
    Height = 253
    Anchors = [akLeft, akTop, akRight, akBottom]
    ScrollBars = ssVertical
    TabOrder = 0
    ExplicitWidth = 221
    ExplicitHeight = 245
  end
  object Tmr: TTimer
    Enabled = False
    OnTimer = TmrTimer
    Left = 56
    Top = 8
  end
  object Cli: TIdCmdTCPClient
    OnDisconnected = CliDisconnected
    OnConnected = CliConnected
    ConnectTimeout = 0
    Host = '192.168.4.100'
    IPVersion = Id_IPv4
    Port = 8664
    ReadTimeout = -1
    CommandHandlers = <
      item
        CmdDelimiter = ' '
        Command = 'DoCmdTest'
        Disconnect = False
        Name = 'cmdDoCmdTest'
        NormalReply.Code = '200'
        ParamDelimiter = ' '
        ParseParams = True
        Tag = 0
        OnCommand = CliCommandHandlers0Command
      end>
    ExceptionReply.Code = '500'
    ExceptionReply.Text.Strings = (
      'Unknown Internal Error')
    Left = 16
    Top = 8
  end
end

【问题讨论】：

@Jerry John 的评论不是开玩笑。尝试添加防冻剂。无论如何，调试器告诉你什么？哪个线程正在阻塞，它在阻塞什么。调试器，特别是现在他们从 D7 天开始有了如此巨大的改进，会告诉你很多。
调试器什么也没告诉我。它只是无缘无故地冻结。我对 Indy 如何实现线程一无所知。如果防冻液不是玩笑，那又是什么呢？
TIdAntiFreeze。调试器什么也没告诉你？！查看线程列表。这应该告诉你阻塞的线程正在等待什么。
我确实首先提到这是我第一次与 Indy 合作，以指出我不会理解这样的术语。正如您所提到的，这是阻塞吗？请记住，我不知道您可能知道的相同术语。
@JerryDodge 尝试将 TIdAntiFreeze 组件添加到您的表单中。

标签： delphi delphi-xe2 freeze indy indy10

【解决方案1】：

你的服务器冻结的原因是你的服务器代码死锁了。

对于连接到TIdCmdTCPServer 的每个客户端，都会创建一个工作线程，从该连接持续读取入站命令，以便它可以触发TIdCmdTCPServer.CommandHandlers 集合中的TIdCommandHandler.OnCommand 事件。 TCli.DoTest() 调用 TIdTCPConnection.SendCmd() 向客户端发送命令并读取其响应。您在主线程的上下文中调用TCli.DoTest()（因此是SendCmd()），因此您有两个单独的线程上下文试图同时从同一个连接中读取，从而导致竞争条件。在TIdCmdTCPServer 内部运行的工作线程可能正在读取部分（如果不是全部）SendCmd() 期望的数据并且永远不会看到，因此SendCmd() 无法正确退出，从而阻止主消息循环能够再次处理新消息，因此冻结。

在服务器应用程序中放置TIdAntiFreeze 可以帮助避免冻结，方法是允许主线程上下文在SendCmd() 死锁时继续处理消息。但这不是真正的解决方案。要真正解决这个问题，您需要重新设计您的服务器应用程序。对于初学者，不要将TIdCmdTCPServer 与TIdCmdTCPClient 一起使用，因为它们并非设计用于一起使用。如果您的服务器要向客户端发送命令，而客户端从不向服务器发送命令，则使用普通的TIdTCPServer 而不是TIdCmdTCPServer。但是即使您不进行更改，您当前的服务器代码仍然存在其他问题。您的服务器事件处理程序未执行线程安全操作，您需要将对 TCli.DoTest() 的调用移出主线程上下文。

试试这个代码：

uServer.pas：

unit uServer; 

interface 

uses 
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.SyncObjs,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, IdBaseComponent, IdComponent,
  IdTCPConnection, IdCustomTCPServer, IdTCPServer, IdThreadSafe, IdYarn, Vcl.StdCtrls, Vcl.Buttons,
  Vcl.ComCtrls; 

type 
  TCli = class(TIdServerContext) 
  private 
    fCmdQueue: TIdThreadSafeStringList;
    fCmdEvent: TEvent;
    function GetIP: String;
  public 
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
    destructor Destroy; override;
    procedure PostCmd(const S: String); 
    property CmdQueue: TIdThreadSafeStringList read fCmdQueue;
    property CmdEvent: TEvent read fCmdEvent;
    property IP: String read GetIP;
  end; 

  TForm3 = class(TForm) 
    Svr: TIdTCPServer; 
    Lst: TListView; 
    Log: TMemo; 
    cmdDoCmdTest: TBitBtn; 
    procedure cmdDoCmdTestClick(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure FormCreate(Sender: TObject); 
    procedure SvrConnect(AContext: TIdContext); 
    procedure SvrDisconnect(AContext: TIdContext); 
    procedure SvrExecute(AContext: TIdContext);
    procedure SvrException(AContext: TIdContext; AException: Exception); 
  public 
    procedure NewContext(AContext: TCli); 
    procedure DelContext(AContext: TCli); 
  end; 

var 
  Form3: TForm3; 

implementation 

uses
  IdSync;

{$R *.dfm} 

{ TLog } 

type
  TLog = class(TIdNotify)
  protected
    fMsg: String;
    procedure DoNotify; override;
  public
    class procedure PostLog(const S: String);
  end;

procedure TLog.DoNotify;
begin
  Form3.Log.Lines.Append(fMsg); 
end;

class procedure TLog.PostLog(const S: String);
begin
  with Create do begin
    fMsg := S;
    Notify;
  end;
end;

{ TCliList }

type
  TCliList = class(TIdSync)
  protected
    fCtx: TCli;
    fAdding: Boolean;
    procedure DoSynchronize; override;
  public
    class procedure AddContext(AContext: TCli);
    class procedure DeleteContext(AContext: TCli);
  end;

procedure TCliList.DoSynchronize;
begin
  if fAdding then
    Form3.NewContext(fCtx)
  else
    Form3.DelContext(fCtx); 
end;

class procedure TCliList.AddContext(AContext: TCli);
begin
  with Create do try
    fCtx := AContext;
    fAdding := True;
    Synchronize;
  finally
    Free;
  end;
end;

class procedure TCliList.DeleteContext(AContext: TCli);
begin
  with Create do try
    fCtx := AContext;
    fAdding := False;
    Synchronize;
  finally
    Free;
  end;
end;

{ TCli } 

constructor TCli.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  fCmdQueue := TIdThreadSafeStringList.Create;
  fCmdEvent := TEvent.Create(nil, True, False, '');
end;

destructor TCli.Destroy;
begin
  fCmdQueue.Free;
  fCmdEvent.Free;
  inherited Destroy;
end;

procedure TCli.PostCmd; 
var
  L: TStringList;
begin
  L := fCmdQueue.Lock;
  try
    L.Add('DoCmdTest');
    fCmdEvent.SetEvent;
  finally
    fCmdQueue.Unlock;
  end;
end; 

function TCli.GetIP: String; 
begin 
  Result := Binding.PeerIP; 
end; 

{ TForm3 } 

procedure TForm3.SvrConnect(AContext: TIdContext); 
var 
  C: TCli; 
begin 
  C := TCli(AContext); 
  TCliList.AddContext(C); 
  TLog.PostLog(C.IP + ': Connected');
end; 

procedure TForm3.SvrDisconnect(AContext: TIdContext); 
var 
  C: TCli; 
begin 
  C := TCli(AContext); 
  TCliList.DeleteContext(C); 
  TLog.PostLog(C.IP + ': Disconnected'); 
end; 

procedure TForm3.SvrExecute(AContext: TIdContext);
var
  C: TCli;
  L, Q: TStringList;
  X: Integer;
begin
  C := TCli(AContext);

  if C.CmdEvent.WaitFor(500) <> wrSignaled then Exit;

  Q := TStringList.Create;
  try
    L := C.CmdQueue.Lock;
    try
      Q.Assign(L);
      L.Clear;
      C.CmdEvent.ResetEvent;
    finally
      C.CmdQueue.Unlock;
    end;
    for X := 0 to Q.Count - 1 do begin
      AContext.Connection.SendCmd(Q.Strings[X]);
    end;
  finally
    Q.Free;
  end;
end;

procedure TForm3.SvrException(AContext: TIdContext; AException: Exception); 
var 
  C: TCli; 
begin 
  C := TCli(AContext); 
  TLog.PostLog(C.IP + ': Exception: ' + AException.Message); 
end; 

procedure TForm3.cmdDoCmdTestClick(Sender: TObject); 
var 
  X: Integer;
  L: TList; 
begin 
  L := Svr.Contexts.LockList; 
  try
    for X := 0 to L.Count - 1 do begin 
      TCli(L.Items[X]).PostCmd; 
    end;
  finally
    Svr.Contexts.UnlockList;
  end; 
end; 

procedure TForm3.DelContext(AContext: TCli); 
var 
  I: TListItem; 
begin 
  I := Lst.FindData(0, AContext, true, false); 
  if I <> nil then I.Delete; 
end; 

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  Svr.Active := False; 
end; 

procedure TForm3.FormCreate(Sender: TObject); 
begin 
  Svr.ContextClass := TCli;
  Svr.Active := True; 
end; 

procedure TForm3.NewContext(AContext: TCli); 
var 
  I: TListItem; 
begin 
  I := Lst.Items.Add; 
  I.Caption := AContext.IP;
  I.Data := AContext; 
end; 

end.

uServer.dfm：

object Form3: TForm3 
  Left = 315 
  Top = 113 
  Caption = 'Indy 10 Command TCP Server' 
  ClientHeight = 308 
  ClientWidth = 529 
  Color = clBtnFace 
  Font.Charset = DEFAULT_CHARSET 
  Font.Color = clWindowText 
  Font.Height = -11 
  Font.Name = 'Tahoma' 
  Font.Style = [] 
  OldCreateOrder = False 
  OnCreate = FormCreate 
  DesignSize = ( 
    529 
    308) 
  PixelsPerInch = 96 
  TextHeight = 13 
  object Lst: TListView 
    Left = 336 
    Top = 8 
    Width = 185 
    Height = 292 
    Anchors = [akTop, akRight, akBottom] 
    Columns = < 
      item 
        AutoSize = True 
      end> 
    TabOrder = 0 
    ViewStyle = vsReport 
    ExplicitLeft = 333 
    ExplicitHeight = 288 
  end 
  object Log: TMemo 
    Left = 8 
    Top = 56 
    Width = 316 
    Height = 244 
    Anchors = [akLeft, akTop, akRight, akBottom] 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [fsBold] 
    ParentFont = False 
    ScrollBars = ssVertical 
    TabOrder = 1 
  end 
  object cmdDoCmdTest: TBitBtn 
    Left = 8 
    Top = 8 
    Width = 217 
    Height = 42 
    Caption = 'Send Test Command' 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -13 
    Font.Name = 'Tahoma' 
    Font.Style = [fsBold] 
    ParentFont = False 
    TabOrder = 2 
    OnClick = cmdDoCmdTestClick 
  end 
  object Svr: TIdTCPServer 
    Bindings = <> 
    DefaultPort = 8664 
    MaxConnections = 100 
    OnConnect = SvrConnect 
    OnDisconnect = SvrDisconnect 
    OnExecute = SvrExecute
    OnException = SvrException 
    Left = 288 
    Top = 8 
  end 
end

uClient.pas：

unit uClient; 

interface 

uses 
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 
  Vcl.ExtCtrls, 
  IdContext, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, 
  IdCmdTCPClient, IdCommandHandlers, Vcl.StdCtrls; 

const                             // --- Change accordingly --- 
  TMR_INT = 10000;                //how often to check for connection 
  SVR_IP =  '192.168.4.100';      //Server IP Address 
  SVR_PORT = 8664;                //Server Port 

type 
  TForm4 = class(TForm) 
    Tmr: TTimer; 
    Cli: TIdCmdTCPClient; 
    Log: TMemo; 
    procedure CliCommandHandlers0Command(ASender: TIdCommand); 
    procedure TmrTimer(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure CliConnected(Sender: TObject); 
    procedure CliDisconnected(Sender: TObject); 
  private 
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
    procedure PostLog(const S: String); 
    procedure PostReconnect;
  public 
  end; 

var 
  Form4: TForm4; 

implementation 

uses
  IdSync;

{$R *.dfm} 

{ TLog } 

type
  TLog = class(TIdNotify)
  protected
    fMsg: String;
    procedure DoNotify; override;
  public
    class procedure PostLog(const S: String);
  end;

procedure TLog.DoNotify;
begin
  Form4.Log.Lines.Append(fMsg); 
end;

class procedure TLog.PostLog(const S: String);
begin
  with Create do begin
    fMsg := S;
    Notify;
  end;
end;

{ TForm4 }

const
  WM_START_RECONNECT_TIMER = WM_USER + 100;

procedure TForm4.CliCommandHandlers0Command(ASender: TIdCommand); 
begin 
  TLog.PostLog('Received command successfully'); 
end; 

procedure TForm4.CliConnected(Sender: TObject); 
begin 
  TLog.PostLog('Connected to Server'); 
end; 

procedure TForm4.CliDisconnected(Sender: TObject); 
begin 
  TLog.PostLog('Disconnected from Server'); 
  PostReconnect;
end; 

procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
  Tmr.Enabled := False;
  Application.OnMessage := nil;
  Cli.Disconnect; 
end; 

procedure TForm4.FormCreate(Sender: TObject); 
begin 
  Application.OnMessage := AppMessage;
  Tmr.Enabled := True; 
end; 

procedure TForm4.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_START_RECONNECT_TIMER then begin
    Handled := True;
    Tmr.Interval := TMR_INT; 
    Tmr.Enabled := True; 
  end;
end;

procedure TForm4.TmrTimer(Sender: TObject); 
begin 
  Tmr.Enabled := False; 

  Cli.Disconnect; 
  try 
    Cli.Host := SVR_IP; 
    Cli.Port := SVR_PORT; 
    Cli.Connect; 
  except 
    PostReconnect;
  end; 
end; 

procedure TForm4.PostReconnect;
begin
  PostMessage(Application.Handle, WM_START_RECONNECT_TIMER, 0, 0);
end;

end.

uClient.dfm：

object Form4: TForm4 
  Left = 331 
  Top = 570 
  Caption = 'Indy 10 Command TCP Client' 
  ClientHeight = 317 
  ClientWidth = 305 
  Color = clBtnFace 
  Font.Charset = DEFAULT_CHARSET 
  Font.Color = clWindowText 
  Font.Height = -11 
  Font.Name = 'Tahoma' 
  Font.Style = [] 
  OldCreateOrder = False 
  OnClose = FormClose 
  OnCreate = FormCreate 
  DesignSize = ( 
    305 
    317) 
  PixelsPerInch = 96 
  TextHeight = 13 
  object Log: TMemo 
    Left = 8 
    Top = 56 
    Width = 289 
    Height = 253 
    Anchors = [akLeft, akTop, akRight, akBottom] 
    ScrollBars = ssVertical 
    TabOrder = 0 
    ExplicitWidth = 221 
    ExplicitHeight = 245 
  end 
  object Tmr: TTimer 
    Enabled = False 
    OnTimer = TmrTimer 
    Left = 56 
    Top = 8 
  end 
  object Cli: TIdCmdTCPClient 
    OnDisconnected = CliDisconnected 
    OnConnected = CliConnected 
    ConnectTimeout = 0 
    Host = '192.168.4.100' 
    IPVersion = Id_IPv4 
    Port = 8664 
    ReadTimeout = -1 
    CommandHandlers = < 
      item 
        CmdDelimiter = ' ' 
        Command = 'DoCmdTest' 
        Disconnect = False 
        Name = 'cmdDoCmdTest' 
        NormalReply.Code = '200' 
        ParamDelimiter = ' ' 
        ParseParams = True 
        Tag = 0 
        OnCommand = CliCommandHandlers0Command 
      end> 
    ExceptionReply.Code = '500' 
    ExceptionReply.Text.Strings = ( 
      'Unknown Internal Error') 
    Left = 16 
    Top = 8 
  end 
end

【讨论】：

我不知道 Indy 服务器使用起来如此复杂......顺便说一句，我将实现客户端 --> 服务器命令，只是目前还没有。
几个代码拼写错误：1) TCli 中的私有字段位于函数下方，2) SvrExecute 缺少 X: Integer;, 3) SvrExecute Connection..?
“对于初学者，不要将 TIdCmdTCPServer 与 TIdCmdTCPClient 一起使用，因为它们不是设计为一起使用的。”那为什么它们的名称和图标几乎相同？它们比豌豆和胡萝卜更适合搭配。
@JerryDodge：我修正了错别字。欢迎来到多线程编程，这要困难得多，你真的要注意上下文。 TIdCmdTCPClient 和 TIdCmdTCPServer 之间唯一的相似之处是它们都有 CommandHandlers 集合，因此 TIdCmd... 命名。它们不配对在一起，一起使用会引起很多麻烦。为了有效地执行双向命令，您通常必须设计异步协议并且根本不使用TIdCmd... 组件，因为它们确实会带来额外的隐含读取而不是帮助。
一段时间后回头看这个问题后，我看到你是多么正确，既有 Indy 库背后的推理，也有你为它的发展做出贡献的事实。

【解决方案2】：

您是否尝试过调试服务器？

线

Result:= TCli(AContext);

（TIdContext 的硬转换）看起来是冻结的潜在原因。

你有没有读过这篇文章，如何让 TIdCustomTCPServer 知道你自己的 TIdServerContext 类？

https://stackoverflow.com/a/5514932/80901

答案中的相关代码：

constructor TOurServer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  ...

    ContextClass := TOurContext;

  ...
end;

【讨论】：

TIdServerContext 在线程中运行，但它本身不是TThread 后代。当客户端连接时，TIdCmdTCPServer 创建ContextClass 的实例并将其传递给内部TThread（如果启用，它可以来自线程池）来管理它。 TIdServerContext 对象在 OnConnect、OnDisconnect、OnExecute 和 OnCommand 事件处理程序中始终有效，它们都在该线程的上下文中触发。
@Remy 感谢您的纠正，我只是从链接的答案中提取了“TThread 后代”注释 - stackoverflow.com/a/5514932/80901 - 没有进一步检查源代码。我编辑了我的答案。