Delphi XE2 Indy 10 TIdCmdTCPServer freezing application - delphi

Question

I'm just starting to learn how to use the Indy 10 components in Delphi XE2. I started with a project that will use the command sockets (TIdCmdTCPServer and TIdCmdTCPClient). I've got everything set up and the client connects to the server, but after the client connects, any command the server sends to the client just freezes the server app, until it eventually crashes and closes (after a deep freeze).
Project Setup
The setup is very simple; there's a small server app and a small client app, each with its corresponding Indy command tcp socket component. There's only one command handler on the client.
Server App
On the server, I have a very simple wrapper for the context type TCli = class(TIdServerContext) which only contains one public property (the inheritance is practically a requirement of Indy).
Client App
The client on the other hand works just fine. It receives the command from the server and does its thing. The client has a timer which auto-connects if it's not already connected. It's currently set to try to connect after 1 second of the app starting, and keep attempting every 10 seconds if not connected already.
Problem Details
I am able to send one or two commands from the server to the client successfully (client responds properly), but the server freezes a few seconds after sending the command. I have event handlers for OnConnect, OnDisconnect, OnContextCreated, and OnException on the server, which all they do really is either post a log or handle connect/disconnect objects in a list view.
Screen Shot
Finally when the client app is gracefully closed, the server also gracefully snaps out of its frozen state. However if the client is forcefully closed, then the server is also forcefully closed. That's the pattern I'm seeing. It posts to a log on events with PostLog(const S: String) which simply appends short messages to a TMemo.
I've done two projects and had the problem on both. I've prepared a sample project...
Server Code (uServer.pas and 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
Client Code (uClient.pas and 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

Answer 1

The reason your server is freezing up is because you are deadlocking your server code.
For each client that connects to TIdCmdTCPServer, a worker thread is created that continuously reads inbound commands from that connection so it can trigger TIdCommandHandler.OnCommand events in the TIdCmdTCPServer.CommandHandlers collection. TCli.DoTest() calls TIdTCPConnection.SendCmd() to send a command to a client and read its response. You are calling TCli.DoTest() (and thus SendCmd()) in the context of the main thread, so you have two separate thread contexts trying to read from the same connection at the same time, causing a race condition. The worker thread running inside of TIdCmdTCPServer is likely reading portions of (if not all of) the data that SendCmd() is expecting and will never see, so SendCmd() does not exit properly, blocking the main message loop from being able to process new messages ever again, hense the freeze.
Placing a TIdAntiFreeze in the server app can help avoid the freezing, by allowing the main thread context to continue processing messages while SendCmd() is deadlocked. But that is not a true solution. To really fix this, you need to redesign your server app. For starters, do not use TIdCmdTCPServer with TIdCmdTCPClient, as they are not designed to be used together. If your server is going to send commands to the client, and the client is never sending commands to the server, then use a plain TIdTCPServer instead of TIdCmdTCPServer. But even if you do not make that change, you still have other problems with your current server code. Your server event handlers are not performing thread-safe operations, and you need to move the call to TCli.DoTest() out of the main thread context.
Try this code:
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

Answer 2

Have you tried debugging the server?
The line
Result:= TCli(AContext);
(hard cast of TIdContext) looks like a potential reason for the freeze.
Have you read this, how to make the TIdCustomTCPServer aware of your own TIdServerContext class?
https://stackoverflow.com/a/5514932/80901
The relevant code in the answer:
constructor TOurServer.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
...
ContextClass := TOurContext;
...
end;