restemplate/indy/Core/IdReply.pas

410 lines
12 KiB
Plaintext
Raw Normal View History

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.27 2/3/05 12:16:46 AM RLebeau
Bug fix for UpdateText()
Rev 1.25 1/15/2005 6:02:02 PM JPMugaas
These should compile again.
Rev 1.24 1/15/05 2:03:20 PM RLebeau
Added AIgnore parameter to TIdReplies.Find()
Updated TIdReply.SetNumericCode() to call SetCode() rather than assigning the
FCode member directly.
Updated TIdReply.SetCode() to call Clear() before assigning the FCode member.
Updated TIdReplies.UpdateText() to ignore the TIdReply that was passed in
when looking for a TIdReply to extract Text from.
Rev 1.23 12/29/04 1:36:44 PM RLebeau
Bug fix for when descendant constructors are called twice during creation
Rev 1.22 10/26/2004 8:43:00 PM JPMugaas
Should be more portable with new references to TIdStrings and TIdStringList.
Rev 1.21 6/11/2004 8:48:24 AM DSiders
Added "Do not Localize" comments.
Rev 1.20 2004.03.01 7:10:34 PM czhower
Change for .net compat
Rev 1.19 2004.03.01 5:12:34 PM czhower
-Bug fix for shutdown of servers when connections still existed (AV)
-Implicit HELP support in CMDserver
-Several command handler bugs
-Additional command handler functionality.
Rev 1.18 2004.02.29 8:16:54 PM czhower
Bug fix to fix AV at design time when adding reply texts to CmdTCPServer.
Rev 1.17 2004.02.03 4:17:10 PM czhower
For unit name changes.
Rev 1.16 2004.01.29 12:02:32 AM czhower
.Net constructor problem fix.
Rev 1.15 1/3/2004 8:06:20 PM JPMugaas
Bug fix: Sometimes, replies will appear twice due to the way functionality
was enherited.
Rev 1.14 1/1/2004 9:33:24 PM BGooijen
the abstract class TIdReply was created sometimes, fixed that
Rev 1.13 2003.10.18 9:33:28 PM czhower
Boatload of bug fixes to command handlers.
Rev 1.12 10/15/2003 7:49:38 PM DSiders
Added IdResourceStringsCore to implementation uses clause.
Rev 1.11 10/15/2003 7:46:42 PM DSiders
Added formatted resource string for the exception raised in
TIdReply.SetCode.
Rev 1.10 2003.09.06 1:30:30 PM czhower
Removed abstract modifier from a class method so that C++ Builder can compile
again.
Rev 1.9 2003.06.05 10:08:50 AM czhower
Extended reply mechanisms to the exception handling. Only base and RFC
completed, handing off to J Peter.
Rev 1.8 2003.05.30 10:25:56 PM czhower
Implemented IsEndMarker
Rev 1.7 2003.05.30 10:06:08 PM czhower
Changed code property mechanisms.
Rev 1.6 5/26/2003 04:29:56 PM JPMugaas
Removed GenerateReply and ParseReply. Those are now obsolete duplicate
functions in the new design.
Rev 1.5 5/26/2003 12:19:54 PM JPMugaas
Rev 1.4 2003.05.26 11:38:18 AM czhower
Rev 1.3 2003.05.25 10:23:44 AM czhower
Rev 1.2 5/20/2003 12:43:46 AM BGooijen
changeable reply types
Rev 1.1 5/19/2003 05:54:58 PM JPMugaas
Rev 1.0 5/19/2003 12:26:16 PM JPMugaas
Base class for reply format objects.
}
unit IdReply;
interface
{$I IdCompilerDefines.inc}
//we need to put this in Delphi mode to work
uses
Classes,
IdException;
type
TIdReplies = class;
//TODO: a streamed write only property will be registered to convert old DFMs
// into the new one for old TextCode and to ignore NumericCode which has been
// removed
TIdReply = class(TCollectionItem)
protected
FCode: string;
FFormattedReply: TStrings;
FReplyTexts: TIdReplies;
FText: TStrings;
//
procedure AssignTo(ADest: TPersistent); override;
procedure CommonInit;
function GetFormattedReplyStrings: TStrings; virtual;
function CheckIfCodeIsValid(const ACode: string): Boolean; virtual;
function GetDisplayName: string; override;
function GetFormattedReply: TStrings; virtual;
function GetNumericCode: Integer;
procedure SetCode(const AValue: string);
procedure SetFormattedReply(const AValue: TStrings); virtual; abstract;
procedure SetText(const AValue: TStrings);
procedure SetNumericCode(const AValue: Integer);
public
procedure Clear; virtual;
//Temp workaround for compiler bug
constructor Create(ACollection: TCollection); override;
constructor CreateWithReplyTexts(ACollection: TCollection; AReplyTexts: TIdReplies); virtual;
// Both creates are necessary. This base one is called by the collection editor at design time
// constructor Create(ACollection: TCollection); overload; override;
// constructor Create(ACollection: TCollection; AReplyTexts: TIdReplies); reintroduce; overload; virtual;
destructor Destroy; override;
// Is not abstract because C++ cannot compile abstract class methods
class function IsEndMarker(const ALine: string): Boolean; virtual;
procedure RaiseReplyError; virtual; abstract;
function ReplyExists: Boolean; virtual;
procedure SetReply(const ACode: Integer; const AText: string); overload; virtual;
procedure SetReply(const ACode: string; const AText: string); overload; virtual;
procedure UpdateText;
//
property FormattedReply: TStrings read GetFormattedReply write SetFormattedReply;
property NumericCode: Integer read GetNumericCode write SetNumericCode;
published
//warning: setting Code has a side-effect of calling Clear;
property Code: string read FCode write SetCode;
property Text: TStrings read FText write SetText;
end;
TIdReplyClass = class of TIdReply;
TIdReplies = class(TOwnedCollection)
protected
function GetItem(Index: Integer): TIdReply;
procedure SetItem(Index: Integer; const Value: TIdReply);
public
function Add: TIdReply; overload;
function Add(const ACode: Integer; const AText: string): TIdReply; overload;
function Add(const ACode, AText: string): TIdReply; overload;
constructor Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass); reintroduce; virtual;
function Find(const ACode: string; AIgnore: TIdReply = nil): TIdReply; virtual;
procedure UpdateText(AReply: TIdReply); virtual;
//
property Items[Index: Integer]: TIdReply read GetItem write SetItem; default;
end;
TIdRepliesClass = class of TIdReplies;
EIdReplyError = class(EIdException);
implementation
uses
IdGlobal, IdResourceStringsCore, SysUtils;
{ TIdReply }
procedure TIdReply.AssignTo(ADest: TPersistent);
var
LR : TIdReply;
begin
if ADest is TIdReply then begin
LR := TIdReply(ADest);
//set code first as it possibly clears the reply
LR.Code := Code;
LR.Text.Assign(Text);
end else begin
inherited AssignTo(ADest);
end;
end;
procedure TIdReply.Clear;
begin
FText.Clear;
FCode := '';
end;
constructor TIdReply.CreateWithReplyTexts(ACollection: TCollection; AReplyTexts: TIdReplies);
begin
inherited Create(ACollection);
FReplyTexts := AReplyTexts;
CommonInit;
end;
constructor TIdReply.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
CommonInit;
end;
destructor TIdReply.Destroy;
begin
FreeAndNil(FText);
FreeAndNil(FFormattedReply);
inherited Destroy;
end;
procedure TIdReply.CommonInit;
begin
FFormattedReply := TStringList.Create;
FText := TStringList.Create;
end;
function TIdReply.GetDisplayName: string;
begin
if Text.Count > 0 then begin
Result := Code + ' ' + Text[0];
end else begin
Result := Code;
end;
end;
function TIdReply.ReplyExists: Boolean;
begin
Result := Code <> '';
end;
procedure TIdReply.SetNumericCode(const AValue: Integer);
begin
Code := IntToStr(AValue);
end;
procedure TIdReply.SetText(const AValue: TStrings);
begin
FText.Assign(AValue);
end;
procedure TIdReply.SetReply(const ACode: Integer; const AText: string);
begin
SetReply(IntToStr(ACode), AText);
end;
function TIdReply.GetNumericCode: Integer;
begin
Result := IndyStrToInt(Code, 0);
end;
procedure TIdReply.SetCode(const AValue: string);
var
LMatchedReply: TIdReply;
begin
if FCode <> AValue then begin
if not CheckIfCodeIsValid(AValue) then begin
raise EIdException.CreateFmt(RSReplyInvalidCode, [AValue]);
end;
// Only check for duplicates if we are in a collection. NormalReply etc are not in collections
// Also dont check FReplyTexts, as non members can be duplicates of members
if Collection <> nil then begin
LMatchedReply := TIdReplies(Collection).Find(AValue);
if Assigned(LMatchedReply) then begin
raise EIdException.CreateFmt(RSReplyCodeAlreadyExists, [AValue]);
end;
end;
Clear;
FCode := AValue;
end;
end;
procedure TIdReply.SetReply(const ACode, AText: string);
begin
Code := ACode;
FText.Text := AText;
end;
function TIdReply.CheckIfCodeIsValid(const ACode: string): Boolean;
begin
Result := True;
end;
class function TIdReply.IsEndMarker(const ALine: string): Boolean;
begin
Result := False;
end;
function TIdReply.GetFormattedReply: TStrings;
begin
// Overrides must call GetFormattedReplyStrings instead. This is just a base implementation
// This is done this way because otherwise double generations can occur if more than one
// ancestor overrides. Example: Reply--> RFC --> FTP. Calling inherited would cause both
// FTP and RFC to generate.
Result := GetFormattedReplyStrings;
end;
function TIdReply.GetFormattedReplyStrings: TStrings;
begin
FFormattedReply.Clear;
Result := FFormattedReply;
end;
procedure TIdReply.UpdateText;
begin
if FReplyTexts <> nil then begin
FReplyTexts.UpdateText(Self);
end;
end;
{ TIdReplies }
function TIdReplies.Add: TIdReply;
begin
Result := TIdReply(inherited Add);
end;
function TIdReplies.Add(const ACode: Integer; const AText: string): TIdReply;
begin
Result := Add(IntToStr(ACode), AText);
end;
function TIdReplies.Add(const ACode, AText: string): TIdReply;
begin
Result := Add;
try
Result.SetReply(ACode, AText);
except
FreeAndNil(Result);
raise;
end;
end;
constructor TIdReplies.Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass);
begin
inherited Create(AOwner, AReplyClass);
end;
function TIdReplies.Find(const ACode: string; AIgnore: TIdReply = nil): TIdReply;
var
i: Integer;
begin
Result := nil;
// Never return match on ''
if ACode <> '' then begin
for i := 0 to Count - 1 do begin
if Items[i].Code = ACode then begin
if not (Items[i] = AIgnore) then begin
Result := Items[i];
Exit;
end;
end;
end;
end;
end;
function TIdReplies.GetItem(Index: Integer): TIdReply;
begin
Result := TIdReply(inherited Items[Index]);
end;
procedure TIdReplies.SetItem(Index: Integer; const Value: TIdReply);
begin
inherited SetItem(Index, Value);
end;
procedure TIdReplies.UpdateText(AReply: TIdReply);
var
LReply: TIdReply;
begin
// If text is blank, get it from the ReplyTexts
if AReply.Text.Count = 0 then begin
// RLebeau - ignore AReply, it doesn't have any text
// to assign, or else the code wouldn't be this far
LReply := Find(AReply.Code, AReply);
if LReply <> nil then begin
AReply.Text.Assign(LReply.Text);
end;
end;
end;
end.