Delphi XE2 Indy 10 TIdCmdTCPServer冻结应用程序 [英] Delphi XE2 Indy 10 TIdCmdTCPServer freezing application
本文介绍了Delphi XE2 Indy 10 TIdCmdTCPServer冻结应用程序的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我刚开始学习如何在Delphi XE2中使用Indy 10组件。我开始使用一个将使用命令套接字（ TIdCmdTCPServer 和 TIdCmdTCPClient ）的项目。我有一切设置，客户端连接到服务器，但在客户端连接后，服务器发送给客户端的任何命令只会冻结服务器应用程序，直到最终崩溃并关闭（深度冻结后）。 p>
项目设置
设置非常简单;有一个小的服务器应用程序和一个小客户端应用程序，每个都有其相应的Indy命令tcp套接字组件。客户端上只有一个命令处理程序。
服务器应用程序
服务器，我有一个非常简单的包装器上下文类型TCli = class（TIdServerContext），它只包含一个公共属性（继承实际上是Indy的要求）。
客户端应用
另一方面，客户端工作正常。它从服务器接收命令，并做它的事情。客户端有一个自动连接的定时器，如果它还没有连接。目前设置尝试在应用程序开始1秒后连接，如果没有连接，请继续尝试每10秒钟。
问题详细信息
我可以将一个或两个命令从服务器发送到客户端（客户端响应正常），但服务器在发送命令后会冻结几秒钟。我有 OnConnect ， OnDisconnect ， OnContextCreated 的事件处理程序，和 OnException 在服务器上，他们所做的一切真的是在列表视图中发布日志或处理连接/断开对象。
屏幕截图
最后，当客户端应用程序正常关闭时，服务器也优雅地从其冻结状态。但是如果客户端被强制关闭，则服务器也被强制关闭。这是我看到的模式。它发布到具有 PostLog（const S：String）的事件登录，它只是将短消息附加到TMemo。
我已经完成了两个项目，并且两者都有问题。我准备了一个示例项目...
服务器代码（ uServer.pas 和 uServer .dfm ）
unit uServer;
接口
使用
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
属性IP：String读取GetIP;
程序DoTest;
结束
TForm3 = class（TForm）
Svr：TIdCmdTCPServer;
Lst：TListView;
日志：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）;
函数NewContext（AContext：TIdContext）：TCli;
procedure DelContext（AContext：TIdContext）;
结束
var
Form3：TForm3;
执行
{$ R * .dfm}
{TCli}
程序TCli.DoTest;
begin
Connection.SendCmd（'DoCmdTest'）;
结束
函数TCli.GetIP：String;
begin
结果：= Binding.PeerIP;
结束
{TForm3}
程序TForm3.PostLog（const S：String）;
begin
Log.Lines.Append（S）;
结束
程序TForm3.SvrConnect（AContext：TIdContext）;
var
C：TCli;
begin
C：= TCli（AContext）;
PostLog（C.IP +'：Connected'）;
结束
程序TForm3.SvrContextCreated（AContext：TIdContext）;
var
C：TCli;
begin
C：= NewContext（AContext）;
PostLog（C.IP +'：上下文创建））;
结束
程序TForm3.SvrDisconnect（AContext：TIdContext）;
var
C：TCli;
begin
C：= TCli（AContext）;
PostLog（C.IP +'：Disconnected'）;
DelContext（AContext）;
结束
procedure TForm3.SvrException（AContext：TIdContext; AException：Exception）;
var
C：TCli;
begin
C：= TCli（AContext）;
PostLog（C.IP +'：异常：'+ AException.Message）;
结束
程序TForm3.cmdDoCmdTestClick（Sender：TObject）;
var
X：整数;
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;
结束
结束
程序TForm3.DelContext（AContext：TIdContext）;
var
I：TListItem;
X：整数;
begin
for X：= 0 to Lst.Items.Count - 1 do begin
I：= Lst.Items [X];
if I.Data = TCli（AContext）然后开始
Lst.Items.Delete（X）;
休息;
结束
结束
结束
procedure TForm3.FormClose（Sender：TObject; var Action：TCloseAction）;
begin
Svr.Active:= False;
结束
procedure TForm3.FormCreate（Sender：TObject）;
begin
Svr.Active:= True;
结束
函数TForm3.NewContext（AContext：TIdContext）：TCli;
var
I：TListItem;
begin
结果：= TCli（AContext）;
I：= Lst.Items.Add;
I.Caption：= Result.IP;
I.Data:=结果;
结束
结束。
//////// DFM ////////
对象Form3：TForm3
左= 315
顶部= 113
Caption ='Indy 10命令TCP服务器'
ClientHeight = 308
ClientWidth = 529
颜色= clBtnFace
Font.Charset = DEFAULT_CHARSET
字体。 Color = clWindowText
Font.Height = -11
Font.Name ='Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize =（
529
308）
PixelsPerInch = 96
TextHeight = 13
对象Lst：TListView
左= 336
顶部= 8
宽度= 185
高度= 292
锚点= [akTop，akRight，akBottom]
列=
item
AutoSize = True
end>
TabOrder = 0
ViewStyle = vsReport
ExplicitLeft = 333
ExplicitHeight = 288
end
对象日志：TMemo
Left = 8
顶部= 56
宽度= 316
高度= 244
锚点= [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
对象cmdDoCmdTest：TBitBtn
左= 8
顶部= 8
宽度= 217
高度= 42
Caption ='发送测试命令'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name ='Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
OnClick = cmdDoCmdTestClick
end
对象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 =（
'帮助跟随'）
MaxConnectionReply.Code ='300'
MaxConnectionReply.Text.Strings =（
'连接太多，稍后再试一次'）
ReplyTexts =<>
ReplyUnknownCommand.Code ='400'
ReplyUnknownCommand.Text.Strings =（
'Unknown Command'）
左= 288
顶部= 8
结束
end
客户端代码（ uClient.pas 和 uClient.dfm ）
unit uClient;
接口
使用
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 // ---相应更改---
TMR_INT = 10000; //检查连接的频率
SVR_IP ='192.168.4.100'; //服务器IP地址
SVR_PORT = 8664; //服务器端口
类型
TForm4 =类（TForm）
Tmr：TTimer;
Cli：TIdCmdTCPClient;
日志：TMemo;
程序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;
实现
{$ R * .dfm}
程序TForm4.PostLog（const S：String）;
begin
Log.Lines.Append（S）;
结束
程序TForm4.CliCommandHandlers0Command（ASender：TIdCommand）;
begin
PostLog（'Received command successfully'）;
结束
procedure TForm4.CliConnected（Sender：TObject）;
begin
PostLog（'Connected to Server'）;
结束
procedure TForm4.CliDisconnected（Sender：TObject）;
begin
PostLog（'与服务器断开连接'）;
结束
procedure TForm4.FormClose（Sender：TObject; var Action：TCloseAction）;
begin
Cli.Disconnect;
结束
程序TForm4.FormCreate（发件人：TObject）;
begin
Tmr.Enabled：= True;
结束
程序TForm4.TmrTimer（Sender：TObject）;
begin
如果Tmr.Interval<> TMR_INT然后
Tmr.Interval：= TMR_INT;
如果不是Cli.Connected然后开始
try
Cli.Host: = SVR_IP;
Cli.Port：= SVR_PORT;
Cli.Connect;
除了
在e：exception do begin
Cli.Disconnect;
结束
结束
结束
结束
结束。
//////// DFM ////////
对象Form4：TForm4
左= 331
顶部= 570
Caption ='Indy 10 Command TCP Client'
ClientHeight = 317
ClientWidth = 305
颜色= clBtnFace
Font.Charset = DEFAULT_CHARSET
字体。 Color = clWindowText
Font.Height = -11
Font.Name ='Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize =（
305
317）
PixelsPerInch = 96
TextHeight = 13
对象日志：TMemo
左= 8
顶部= 56
宽度= 289
高度= 253
锚点= [akLeft，akTop，akRight，akBottom]
ScrollBars = ssVertical
TabOrder = 0
ExplicitWidth = 221
ExplicitHeight = 245
end
对象Tmr：TTimer
启用= False
OnTimer = TmrTimer
左= 56
顶部= 8
end
对象Cli：TIdCmdTCPCl ient
OnDisconnected = CliDisconnected
OnConnected = CliConnected
ConnectTimeout = 0
主机='192.168.4.100'
IPVersion = Id_IPv4
端口= 8664
ReadTimeout = -1
CommandHandlers =<
item
CmdDelimiter =''
Command ='DoCmdTest'
Disconnect = False
Name ='cmdDoCmdTest'
NormalReply.Code ='200'
ParamDelimiter =''
ParseParams = True
标签= 0
OnCommand = CliCommandHandlers0Command
end>
ExceptionReply.Code ='500'
ExceptionReply.Text.Strings =（
'Unknown Internal Error'）
Left = 16
Top = 8
end
end
解决方案
冻结是因为您的服务器代码死锁。
对于连接到 TIdCmdTCPServer 的每个客户端，工作线程被创建为连续读取来自该连接的入站命令，因此它可以在 TIdCmdTCPServer.CommandHandlers 集合中触发 TIdCommandHandler.OnCommand 事件。 TCli.DoTest（）调用 TIdTCPConnection.SendCmd（）向客户端发送命令并读取其响应。在主线程的上下文中，您正在调用 TCli.DoTest（）（因此 SendCmd（））您有两个单独的线程上下文尝试从同一个连接同时读取，导致竞争条件。运行在 TIdCmdTCPServer 内的工作线程可能会读取 SendCmd（）的数据（如果不是全部）期待并且永远不会看到，所以 SendCmd（）没有正确退出，阻止主要消息循环再次处理新的消息，结束冻结。 p>
在服务器应用程序中放置 TIdAntiFreeze 可以通过允许主线程上下文继续处理消息来帮助避免冻结 SendCmd（）是死锁的。但这不是一个真正的解决方案。要真正解决这个问题，您需要重新设计您的服务器应用程序。对于初学者，不要将 TIdCmdTCPServer 与 TIdCmdTCPClient 一起使用，因为它们不能一起使用。如果您的服务器要向客户端发送命令，并且客户端从不向服务器发送命令，请使用一个简单的 TIdTCPServer 而不是 TIdCmdTCPServer 。但即使您没有做出这一改变，您仍然有其他问题与您当前的服务器代码。您的服务器事件处理程序不执行线程安全操作，您需要将调用从主线程上下文移动到 TCli.DoTest（）。
尝试此代码：
uServer.pas：
unit uServer;
接口
使用
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;
函数GetIP：String;
public
构造函数创建（AConnection：TIdTCPConnection; AYarn：TIdYarn; AList：TThreadList = nil）;覆盖
析构函数覆盖
procedure PostCmd（const S：String）;
属性CmdQueue：TIdThreadSafeStringList读取fCmdQueue;
属性CmdEvent：TEvent读取fCmdEvent;
属性IP：String读取GetIP;
结束
TForm3 = class（TForm）
Svr：TIdTCPServer;
Lst：TListView;
日志：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）;
结束
var
Form3：TForm3;
实现
使用
IdSync;
{$ R * .dfm}
{TLog}
type
TLog = class（TIdNotify）
protected
fMsg：String;
程序DoNotify;覆盖
public
类过程PostLog（const S：String）;
结束
程序TLog.DoNotify;
begin
Form3.Log.Lines.Append（fMsg）;
结束
类过程TLog.PostLog（const S：String）;
begin
with Create do begin
fMsg：= S;
通知;
结束
结束
{TCliList}
type
TCliList = class（TIdSync）
protected
fCtx：TCli;
fAdding：Boolean;
procedure DoSynchronize;覆盖
public
类过程AddContext（AContext：TCli）;
类程序DeleteContext（AContext：TCli）;
结束
程序TCliList.DoSynchronize;
begin
如果fAdding then
Form3.NewContext（fCtx）
else
Form3.DelContext（fCtx）;
结束
类程序TCliList.AddContext（AContext：TCli）;
begin
with Create do try
fCtx：= AContext;
fAdding：= True;
同步;
终于
免费;
结束
结束
类程序TCliList.DeleteContext（AContext：TCli）;
begin
with Create do try
fCtx：= AContext;
fAdding：= False;
同步;
终于
免费;
结束
结束
{TCli}
构造函数TCli.Create（AConnection：TIdTCPConnection; AYarn：TIdYarn; AList：TThreadList = nil）;
begin
继承Create（AConnection，AYarn，AList）;
fCmdQueue：= TIdThreadSafeStringList.Create;
fCmdEvent：= TEvent.Create（nil，True，False，''）;
结束
析构函数TCli.Destroy;
begin
fCmdQueue.Free;
fCmdEvent.Free;
继承了Destroy;
结束
procedure TCli.PostCmd;
var
L：TStringList;
begin
L：= fCmdQueue.Lock;
try
L.Add（'DoCmdTest'）;
fCmdEvent.SetEvent;
finally
fCmdQueue.Unlock;
结束
结束
函数TCli.GetIP：String;
begin
结果：= Binding.PeerIP;
结束
{TForm3}
程序TForm3.SvrConnect（AContext：TIdContext）;
var
C：TCli;
begin
C：= TCli（AContext）;
TCliList.AddContext（C）;
TLog.PostLog（C.IP +'：Connected'）;
结束
程序TForm3.SvrDisconnect（AContext：TIdContext）;
var
C：TCli;
begin
C：= TCli（AContext）;
TCliList.DeleteContext（C）;
TLog.PostLog（C.IP +'：Disconnected'）;
结束
程序TForm3.SvrExecute（AContext：TIdContext）;
var
C：TCli;
L，Q：TStringList;
X：整数;
开始
C：= TCli（AContext）;
如果C.CmdEvent.WaitFor（500）< wrSignaled然后退出;
Q：= TStringList.Create;
try
L：= C.CmdQueue.Lock;
try
Q.Assign（L）;
L.Clear;
C.CmdEvent.ResetEvent;
finally
C.CmdQueue.Unlock;
结束
for X：= 0 to Q.Count - 1 do begin
AContext.Connection.SendCmd（Q.Strings [X]）;
结束
finally
Q.Free;
结束
结束
procedure TForm3.SvrException（AContext：TIdContext; AException：Exception）;
var
C：TCli;
begin
C：= TCli（AContext）;
TLog.PostLog（C.IP +'：异常：'+ AException.Message）;
结束
程序TForm3.cmdDoCmdTestClick（Sender：TObject）;
var
X：整数;
L：TList;
begin
L：= Svr.Contexts.LockList;
尝试
for X：= 0 to L.Count - 1 do begin
TCli（L.Items [X]）。PostCmd;
结束
finally
Svr.Contexts.UnlockList;
结束
结束
procedure TForm3.DelContext（AContext：TCli）;
var
I：TListItem;
begin
I：= Lst.FindData（0，AContext，true，false）;
if I<零，然后删除;
结束
procedure TForm3.FormClose（Sender：TObject; var Action：TCloseAction）;
begin
Svr.Active：= False;
结束
procedure TForm3.FormCreate（Sender：TObject）;
begin
Svr.ContextClass：= TCli;
Svr.Active：= True;
结束
程序TForm3.NewContext（AContext：TCli）;
var
I：TListItem;
begin
I：= Lst.Items.Add;
I.Caption：= AContext.IP;
I.Data：= AContext;
结束
结束。
uServer.dfm：
对象Form3：TForm3
Left = 315
顶部= 113
Caption ='Indy 10命令TCP服务器'
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
对象Lst：TListView
左= 336
顶部= 8
宽度= 185
高度= 292
锚点= [akTop，akRight ，akBottom]
Columns =<
item
AutoSize = True
end>
TabOrder = 0
ViewStyle = vsReport
ExplicitLeft = 333
ExplicitHeight = 288
end
对象日志：TMemo
Left = 8
顶部= 56
宽度= 316
高度= 244
锚点= [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
对象cmdDoCmdTest：TBitBtn
左= 8
顶部= 8
宽度= 217
高度= 42
Caption ='发送测试命令'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name ='Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 2
OnClick = cmdDoCmdTestClick
end
对象Svr：TIdTCPServer
Bindings =<>
DefaultPort = 8664
MaxConnections = 100
OnConnect = SvrConnect
OnDisconnect = SvrDisconnect
OnExecute = SvrExecute
OnException = SvrException
Left = 288
顶部= 8
结束
结束
uClient.pas： / p>
unit uClient;
接口
使用
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 // ---相应更改---
TMR_INT = 10000; //检查连接的频率
SVR_IP ='192.168.4.100'; //服务器IP地址
SVR_PORT = 8664; //服务器端口
类型
TForm4 =类（TForm）
Tmr：TTimer;
Cli：TIdCmdTCPClient;
日志：TMemo;
程序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;
实现
使用
IdSync;
{$ R * .dfm}
{TLog}
type
TLog = class（TIdNotify）
protected
fMsg：String;
程序DoNotify;覆盖
public
类过程PostLog（const S：String）;
结束
程序TLog.DoNotify;
begin
Form4.Log.Lines.Append（fMsg）;
结束
类过程TLog.PostLog（const S：String）;
begin
with Create do begin
fMsg：= S;
通知;
结束
结束
{TForm4}
const
WM_START_RECONNECT_TIMER = WM_USER + 100;
程序TForm4.CliCommandHandlers0Command（ASender：TIdCommand）;
begin
TLog.PostLog（'Received command successfully'）;
结束
程序TForm4.CliConnected（发件人：TObject）;
begin
TLog.PostLog（'Connected to Server'）;
结束
procedure TForm4.CliDisconnected（Sender：TObject）;
begin
TLog.PostLog（'与服务器断开连接'）;
PostReconnect;
结束
procedure TForm4.FormClose（Sender：TObject; var Action：TCloseAction）;
begin
Tmr.Enabled：= False;
Application.OnMessage：= nil;
Cli.Disconnect;
结束
程序TForm4.FormCreate（发件人：TObject）;
begin
Application.OnMessage：= AppMessage;
Tmr.Enabled：= True;
结束
程序TForm4.AppMessage（var Msg：TMsg; var Handled：Boolean）;
begin
如果Msg.message = WM_START_RECONNECT_TIMER然后开始
处理：= True;
Tmr.Interval：= TMR_INT;
Tmr.Enabled：= True;
结束
结束
程序TForm4.TmrTimer（Sender：TObject）;
begin
Tmr.Enabled：= False;
Cli.Disconnect;
try
Cli.Host：= SVR_IP;
Cli.Port：= SVR_PORT;
Cli.Connect;
除了
PostReconnect;
结束
结束
程序TForm4.PostReconnect;
begin
PostMessage（Application.Handle，WM_START_RECONNECT_TIMER，0，0）;
结束
结束。
uClient.dfm：
对象Form4：TForm4
Left = 331
顶部= 570
Caption ='Indy 10命令TCP客户端'
ClientHeight = 317
ClientWidth = 305
颜色= 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
对象日志：TMemo
左侧= 8
顶部= 56
宽度= 289
高度= 253
Anchors = [akLeft，akTop，akRight，akBottom]
ScrollBars = ssVertical
TabOrder = 0
ExplicitWidth = 221
ExplicitHeight = 245
end
object Tmr：TTimer
Enabled = False
OnTimer = TmrTimer
左= 56
顶部= 8
end
对象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
标签= 0
OnCommand = CliCommandHandlers0Command
end>
ExceptionReply.Code ='500'
ExceptionReply.Text.Strings =（
'Unknown Internal Error'）
Left = 16
Top = 8
结束
结束
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
解决方案
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
这篇关于Delphi XE2 Indy 10 TIdCmdTCPServer冻结应用程序的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
