Note that there are some explanatory texts on larger screens.

plurals
  1. PODelphi XE2 Indy 10 TIdCmdTCPServer freezing application
    primarykey
    data
    text
    <p>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 (<code>TIdCmdTCPServer</code> and <code>TIdCmdTCPClient</code>). 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).</p> <p><strong>Project Setup</strong></p> <p>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.</p> <p><strong>Server App</strong></p> <p>On the server, I have a very simple wrapper for the context <code>type TCli = class(TIdServerContext)</code> which only contains one public property (the inheritance is practically a requirement of Indy). </p> <p><strong>Client App</strong></p> <p>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.</p> <p><strong>Problem Details</strong></p> <p>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 <code>OnConnect</code>, <code>OnDisconnect</code>, <code>OnContextCreated</code>, and <code>OnException</code> on the server, which all they do really is either post a log or handle connect/disconnect objects in a list view.</p> <p><strong>Screen Shot</strong></p> <p><img src="https://i.stack.imgur.com/YKGhf.png" alt="Server app frozen after 2 clicks"></p> <p>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 <code>PostLog(const S: String)</code> which simply appends short messages to a TMemo.</p> <p>I've done two projects and had the problem on both. I've prepared a sample project...</p> <p><strong>Server Code</strong> (<em>uServer.pas</em> and <em>uServer.dfm</em>)</p> <pre><code>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 = &lt; item AutoSize = True end&gt; 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 = &lt;&gt; DefaultPort = 8664 MaxConnections = 100 OnContextCreated = SvrContextCreated OnConnect = SvrConnect OnDisconnect = SvrDisconnect OnException = SvrException CommandHandlers = &lt;&gt; 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 = &lt;&gt; ReplyUnknownCommand.Code = '400' ReplyUnknownCommand.Text.Strings = ( 'Unknown Command') Left = 288 Top = 8 end end </code></pre> <p><strong>Client Code</strong> (<em>uClient.pas</em> and <em>uClient.dfm</em>)</p> <pre><code>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 &lt;&gt; 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 = &lt; item CmdDelimiter = ' ' Command = 'DoCmdTest' Disconnect = False Name = 'cmdDoCmdTest' NormalReply.Code = '200' ParamDelimiter = ' ' ParseParams = True Tag = 0 OnCommand = CliCommandHandlers0Command end&gt; ExceptionReply.Code = '500' ExceptionReply.Text.Strings = ( 'Unknown Internal Error') Left = 16 Top = 8 end end </code></pre>
    singulars
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload