Delphi: Indy TIdTCPClient Reading Data

Question

I am using Delphi 2007 & Indy 10; I am a bit of a Delphi noob so apologies if I have missed something obvious...

Background: I have a simple server app which simply sends the word "PING" when you connect to its port. It will also respond if it receives the word "PONG". This is working fine, I have manually tested this using netcat/wireshark.

I am trying to code my client to connect to the port and automatically respond to the word PING whenever it receives it. I have created a simple form with a button to manually connect.

The client connects, but it does not respond to the word PING. I think the problem lies with:

TLog.AddMsg(FConn.IOHandler.ReadLn);

My debug log reports only as far as "DEBUG: TReadingThread.Execute - FConn.Connected".

My client code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdCustomTransparentProxy, IdSocks, IdBaseComponent,
  IdComponent, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
  IdTCPConnection, IdTCPClient, IdSync;

type

  TReadingThread = class(TThread)
  protected
    FConn: TIdTCPConnection;
    procedure Execute; override;
  public
    constructor Create(AConn: TIdTCPConnection); reintroduce;
  end;

  TLog = class(TIdSync)
  protected
    FMsg: String;
  procedure DoSynchronize; override;
  public
    constructor Create(const AMsg: String);
    class procedure AddMsg(const AMsg: String);
  end;


  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    IdIOHandlerStack1: TIdIOHandlerStack;
    client: TIdTCPClient;
    IdSocksInfo1: TIdSocksInfo;
    procedure Button1Click(Sender: TObject);
    procedure clientConnected(Sender: TObject);
    procedure clientDisconnected(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  rt: TReadingThread = nil;

implementation

{$R *.dfm}

constructor TReadingThread.Create(AConn: TIdTCPConnection);
begin
  Form1.Memo1.Lines.Add('DEBUG: TReadingThread.Create'); // Debug

  FConn := AConn;
  inherited Create(False);
end;

procedure TReadingThread.Execute;
begin
  Form1.Memo1.Lines.Add('DEBUG: TReadingThread.Execute'); // Debug

  while not Terminated and FConn.Connected do
  begin
    Form1.Memo1.Lines.Add('DEBUG: TReadingThread.Execute - FConn.Connected'); // Debug

    TLog.AddMsg(FConn.IOHandler.ReadLn);
  end;
end;

constructor TLog.Create(const AMsg: String);
begin
  Form1.Memo1.Lines.Add('DEBUG: TLog.Create'); // Debug

  FMsg := AMsg;
  inherited Create;
end;

procedure TLog.DoSynchronize;
var
  cmd : string;
begin
  Form1.Memo1.Lines.Add('DEBUG: TLog.DoSynchronize'); // Debug

  cmd := copy(FMsg, 1, 1);

  if cmd='PING' then  begin
    Form1.client.Socket.WriteLn('PONG');
  end

end;

class procedure TLog.AddMsg(const AMsg: String);
begin
  Form1.Memo1.Lines.Add('DEBUG: TLog.AddMsg');  // Debug

  with Create(AMsg) do try
    Synchronize;
    finally
    Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Host : String;
  Port : Integer;
begin

  Host := '127.0.0.1';
  Port := StrToInt('1234');

  client.Host := Host;
  client.Port := Port;

  with client do
  begin
    try
      Connect;
      except
      on E: Exception do
      Memo1.Lines.Add('Error: ' + E.Message);
    end;
  end;

end;

procedure TForm1.clientConnected(Sender: TObject);
begin
  Form1.Memo1.Lines.Add('DEBUG: TForm1.clientConnected'); // Debug

  rt := TReadingThread.Create(client);
end;

procedure TForm1.clientDisconnected(Sender: TObject);
begin
  Form1.Memo1.Lines.Add('DEBUG: TForm1.clientDisconnected');  // Debug

  if rt <> nil then
    begin
      rt.Terminate;
      rt.WaitFor;
      FreeAndNil(rt);
    end;
end;

end.

Any help/advice would be appreciated.

Thanks

Remy Lebeau Remy Lebeau · Accepted Answer · 2013-06-28T21:08:14

The reading thread is directly accessing Form1.Memo1, which is not thread safe and can cause deadlocks, crashes, corrupted memory, etc. So it is possible that the reading thread is not even reaching the ReadLn() call at all. You MUST synchronize ALL access to UI controls to the main thread, no matter how trivial the access actually is. Just don't risk it.

Also, you are doing your thread's ping/pong logic inside of TLog itself, where it does not belong. Not to mention that you are truncating the cmd to only its first character before checking its value, so it will NEVER detect a PING command. You need to move the logic back into the thread, where it really belongs, and remove the truncation.

Try this:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdCustomTransparentProxy, IdSocks, IdBaseComponent,
  IdComponent, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
  IdTCPConnection, IdTCPClient, IdSync;

type

  TReadingThread = class(TThread)
  protected
    FConn: TIdTCPConnection;
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(AConn: TIdTCPConnection); reintroduce;
  end;

  TLog = class(TIdSync)
  protected
    FMsg: String;
    procedure DoSynchronize; override;
  public
    constructor Create(const AMsg: String);
    class procedure AddMsg(const AMsg: String);
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    IdIOHandlerStack1: TIdIOHandlerStack;
    client: TIdTCPClient;
    IdSocksInfo1: TIdSocksInfo;
    procedure Button1Click(Sender: TObject);
    procedure clientConnected(Sender: TObject);
    procedure clientDisconnected(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  rt: TReadingThread = nil;

implementation

{$R *.dfm}

constructor TReadingThread.Create(AConn: TIdTCPConnection);
begin
  TLog.AddMsg('DEBUG: TReadingThread.Create');
  FConn := AConn;
  inherited Create(False);
end;

procedure TReadingThread.Execute;
var
  cmd: string;
begin
  TLog.AddMsg('DEBUG: TReadingThread.Execute');

  while not Terminated do
  begin
    cmd := FConn.IOHandler.ReadLn;
    TLog.AddMsg('DEBUG: TReadingThread.Execute. Cmd: ' + cmd);
    if cmd = 'PING' then begin
      FConn.IOHandler.WriteLn('PONG');
    end
  end;
end;

procedure TReadingThread.DoTerminate;
begin
  TLog.AddMsg('DEBUG: TReadingThread.DoTerminate');
  inherited;
end;

constructor TLog.Create(const AMsg: String);
begin
  inherited Create;
  FMsg := AMsg;
end;

procedure TLog.DoSynchronize;
begin
  Form1.Memo1.Lines.Add(FMsg);
end;

class procedure TLog.AddMsg(const AMsg: String);
begin
  with Create(AMsg) do
  try
    Synchronize;
  finally
    Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Host : String;
  Port : Integer;
begin
  Host := '127.0.0.1';
  Port := StrToInt('1234');

  client.Host := Host;
  client.Port := Port;

  try
    client.Connect;
  except
    on E: Exception do
      TLog.AddMsg('Error: ' + E.Message);
    end;
  end;
end;

procedure TForm1.clientConnected(Sender: TObject);
begin
  TLog.AddMsg('DEBUG: TForm1.clientConnected');
  rt := TReadingThread.Create(client);
end;

procedure TForm1.clientDisconnected(Sender: TObject);
begin
  TLog.AddMsg('DEBUG: TForm1.clientDisconnected');
  if rt <> nil then
  begin
    rt.Terminate;
    rt.WaitFor;
    FreeAndNil(rt);
  end;
end;

end.

If that still does not work, then make sure the server is actually delimiting the PING string with a CRLF sequence, or at least a LF character (which is the minimum that ReadLn() looks for by default).

Delphi: Indy TIdTCPClient Reading Data

1 Answers