SmartThreadLib example: Using blocking Indy sockets in a thread

Problem/Question/Abstract:

This is an example on how to use the SmartThreadLib. It provides a class called TTCPSmartThread. This thread contains some basic routines to perform TCP communication using blocking sockets.

Answer:

Below are the folling files:

TCPSmartThread.pas   -  The unit
main.pas  -  demo showing how to use it

{ Smart Thread Lib - TCP example
  Copyright (c) 2002 by DelphiFactory Netherlands BV

  What is it:
  Provides an easy way to use Indy blocking TCP socket client.

  Usage:
  Create your TCP client threads as TTCPSmartThreads and manage them
  using the SmartThreadManager global object.

  Download SmartThreadLib at:
  http://www.delphi3000.com/articles/article_3046.asp

  More about blocking sockets and indy:
  http://www.hower.org/Kudzu/Articles/IntroToIndy/
}

unit TCPSmartThread;

interface

uses
  SysUtils, SmartThreadLib, IdTCPClient, IdException;

resourcestring
  STCPTimedOut = 'Time out while waiting for TCP/IP data';

type
  TTCPSmartThread = class(TSmartThread)
  private
    FWaitDelay: Integer; { time slice during waiting (msec) }
    FMaxWaitCount: Integer;
    FTCP: TIdTCPClient;
  protected
    procedure SmartExecute; override;
    procedure TCPExecute; virtual; abstract;

    procedure Connect(const Host: string; const Port: Integer);
    procedure Disconnect;
    procedure WaitFor(const S: string);
    procedure Write(const S: string);
    procedure WaitForAndWrite(const WaitStr, SendStr: string);
    function ReadLn: string;
  end;

implementation

{ TSmartTCP }

procedure TTCPSmartThread.Connect(const Host: string; const Port: Integer);
begin
  // Disconnect if needed
  Disconnect;

  // setup connection info
  FTCP.Host := Host;
  FTCP.Port := Port;

  // Connect
  FTCP.Connect;

  Check;
end;

procedure TTCPSmartThread.Disconnect;
begin
  Check;
  // disconnect if connected
  if FTCP.Connected then
    FTCP.Disconnect;
  Check;
end;

function TTCPSmartThread.ReadLn: string;
{ Reads a string from the connection.
  The string must be terminated by a LF (#10)
}
const
  EndOfLineMarker = #10;
var
  I: Integer;
begin
  I := 0;
  repeat
    // raise exception if we need to stop
    Check;
    // try to read data
    Result := FTCP.ReadLn(EndOfLineMarker, FWaitDelay);
    // increase the try counter
    Inc(I);
    // exit loop after to many tries, or if data found
  until (not FTCP.ReadLnTimedOut) or (I > FMaxWaitCount);
  // raise an exception if the read data timed out
  if FTCP.ReadLnTimedOut then
    raise EIdResponseError.Create('time out');
  // perform check
  Check;
end;

procedure TTCPSmartThread.SmartExecute;
begin
  FWaitDelay := 100;
  FMaxWaitCount := 5000 div FWaitDelay;
  FTCP := TIdTCPClient.Create(nil);
  try
    TCPExecute;
  finally
    FTCP.Free;
  end;
end;

procedure TTCPSmartThread.WaitFor(const S: string);
{ This function returns when the string specified by S
  is read from the TCP connection.
  A timeout exception can be raised.
}
var
  I: Integer;
begin
  I := 0;
  repeat
    // raise exception if we need to stop
    Check;
    // try to read data
    FTCP.ReadLn(S, FWaitDelay);
    // increase number of tries
    Inc(I);
  until (not FTCP.ReadLnTimedOut) or (I > FMaxWaitCount);
  if FTCP.ReadLnTimedOut then
    raise EIdResponseError.Create(STCPTimedOut);
  Check;
end;

procedure TTCPSmartThread.WaitForAndWrite(const WaitStr, SendStr: string);
{ Wait's for a special string and then sends a reply. }
begin
  WaitFor(WaitStr);
  Write(SendStr);
end;

procedure TTCPSmartThread.Write(const S: string);
{ Send a string over the connection }
begin
  Check;
  FTCP.Write(S);
  Check;
end;

end.

{ Using the TTCPSmartThread to retreive the time and date:   }

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SmartThreadLib, TCPSmartThread, IdException;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure OnMessage(Sender: TObject; const AMessage: string);
  public
    { Public declarations }
  end;

type
  TTestThread = class(TTCPSmartThread)
  protected
    procedure TCPExecute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.TCPExecute;
begin
  Connect('132.163.4.101', 13);
  while True do
    Msg(Readln);
  Disconnect;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  SmartThreadManager.OnMessage := OnMessage;
  TTestThread.Create;
end;

procedure TForm1.OnMessage(Sender: TObject; const AMessage: string);
begin
  Memo1.lines.add(AMessage);
end;

end.