我刚刚开始学习如何在 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