Title: SmartThreadLib example: Using blocking Indy sockets in a thread
Question: 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 (IFMaxWaitCount);
// 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 (IFMaxWaitCount);
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.