313 lines
9.2 KiB
Plaintext
313 lines
9.2 KiB
Plaintext
{
|
|
$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.29 1/15/05 2:28:28 PM RLebeau
|
|
Added local variables to TIdReplyRFC.GetFormattedReply() to reduce the number
|
|
of repeated string operations that were being performed.
|
|
|
|
Updated TIdRepliesRFC.UpdateText() to ignore the TIdReply that was passed in
|
|
when looking for a TIdReply to extract Text from.
|
|
|
|
Rev 1.28 10/26/2004 8:43:00 PM JPMugaas
|
|
Should be more portable with new references to TIdStrings and TIdStringList.
|
|
|
|
Rev 1.27 6/11/2004 8:48:28 AM DSiders
|
|
Added "Do not Localize" comments.
|
|
|
|
Rev 1.26 18/05/2004 23:17:18 CCostelloe
|
|
Bug fix
|
|
|
|
Rev 1.25 5/18/04 2:39:02 PM RLebeau
|
|
Added second constructor to TIdRepliesRFC
|
|
|
|
Rev 1.24 5/17/04 9:50:08 AM RLebeau
|
|
Changed TIdRepliesRFC constructor to use 'reintroduce' instead
|
|
|
|
Rev 1.23 5/16/04 5:12:04 PM RLebeau
|
|
Added construvtor to TIdRepliesRFC class
|
|
|
|
Rev 1.22 2004.03.01 5:12:36 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.21 2004.02.29 8:17:20 PM czhower
|
|
Minor cosmetic changes to code.
|
|
|
|
Rev 1.20 2004.02.03 4:16:50 PM czhower
|
|
For unit name changes.
|
|
|
|
Rev 1.19 1/3/2004 8:06:18 PM JPMugaas
|
|
Bug fix: Sometimes, replies will appear twice due to the way functionality
|
|
was enherited.
|
|
|
|
Rev 1.18 2003.10.18 9:33:28 PM czhower
|
|
Boatload of bug fixes to command handlers.
|
|
|
|
Rev 1.17 9/20/2003 10:01:04 AM JPMugaas
|
|
Minor change. WIll now accept all 3 digit numbers (not just ones below 600).
|
|
The reason is that developers may want something in 600-999 range. RFC 2228
|
|
defines a 6xx reply range for protected replies.
|
|
|
|
Rev 1.16 2003.09.20 10:33:14 AM czhower
|
|
Bug fix to allow clearing code field (Return to default value)
|
|
|
|
Rev 1.15 2003.06.05 10:08:52 AM czhower
|
|
Extended reply mechanisms to the exception handling. Only base and RFC
|
|
completed, handing off to J Peter.
|
|
|
|
Rev 1.14 6/3/2003 04:09:30 PM JPMugaas
|
|
class function TIdReplyRFC.IsEndMarker(const ALine: string): Boolean had the
|
|
wrong parameters causing FTP to freeze. It probably effected other stuff.
|
|
|
|
Rev 1.13 5/30/2003 8:37:42 PM BGooijen
|
|
Changed virtual to override
|
|
|
|
Rev 1.12 2003.05.30 10:25:58 PM czhower
|
|
Implemented IsEndMarker
|
|
|
|
Rev 1.11 2003.05.30 10:06:08 PM czhower
|
|
Changed code property mechanisms.
|
|
|
|
Rev 1.10 2003.05.26 10:48:12 PM czhower
|
|
1) Removed deprecated code.
|
|
2) Removed POP3 bastardizations as they are now in IdReplyPOP3.
|
|
|
|
Rev 1.9 5/26/2003 12:19:52 PM JPMugaas
|
|
|
|
Rev 1.8 2003.05.26 11:38:20 AM czhower
|
|
|
|
Rev 1.7 5/25/2003 03:16:54 AM JPMugaas
|
|
|
|
Rev 1.6 2003.05.25 10:23:46 AM czhower
|
|
|
|
Rev 1.5 5/21/2003 08:43:38 PM JPMugaas
|
|
Overridable hook for the SMTP Reply object.
|
|
|
|
Rev 1.4 5/20/2003 12:43:48 AM BGooijen
|
|
changeable reply types
|
|
|
|
Rev 1.3 5/19/2003 12:26:50 PM JPMugaas
|
|
Now uses base class.
|
|
|
|
Rev 1.2 11/05/2003 23:29:04 CCostelloe
|
|
IMAP-specific code moved up to TIdIMAP4.pas
|
|
|
|
Rev 1.1 11/14/2002 02:51:54 PM JPMugaas
|
|
Added FormatType property. If it is rfIndentMidLines, it will accept
|
|
properly parse reply lines that begin with a space. Setting this to
|
|
rfIndentMidLines will also cause the reply object to generate lines that
|
|
start with a space if the Text.Line starts with a space. This should
|
|
accommodate the FTP MLSD and FEAT commands on both the client and server.
|
|
|
|
Rev 1.0 11/13/2002 08:45:50 AM JPMugaas
|
|
}
|
|
|
|
unit IdReplyRFC;
|
|
|
|
interface
|
|
{$I IdCompilerDefines.inc}
|
|
uses
|
|
Classes,
|
|
IdReply;
|
|
|
|
type
|
|
TIdReplyRFC = class(TIdReply)
|
|
protected
|
|
procedure AssignTo(ADest: TPersistent); override;
|
|
function CheckIfCodeIsValid(const ACode: string): Boolean; override;
|
|
function GetFormattedReply: TStrings; override;
|
|
procedure SetFormattedReply(const AValue: TStrings); override;
|
|
public
|
|
class function IsEndMarker(const ALine: string): Boolean; override;
|
|
procedure RaiseReplyError; override;
|
|
function ReplyExists: Boolean; override;
|
|
end;
|
|
|
|
TIdRepliesRFC = class(TIdReplies)
|
|
public
|
|
constructor Create(AOwner: TPersistent); reintroduce; overload; virtual;
|
|
constructor Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass); overload; override;
|
|
procedure UpdateText(AReply: TIdReply); override;
|
|
end;
|
|
|
|
// This exception is for protocol errors such as 404 HTTP error and also
|
|
// SendCmd / GetResponse
|
|
EIdReplyRFCError = class(EIdReplyError)
|
|
protected
|
|
FErrorCode: Integer;
|
|
public
|
|
// Params must be in this order to avoid conflict with CreateHelp
|
|
// constructor in CBuilder as CB does not differentiate constructors
|
|
// by name as Delphi does
|
|
constructor CreateError(const AErrorCode: Integer;
|
|
const AReplyMessage: string); reintroduce; virtual;
|
|
//
|
|
property ErrorCode: Integer read FErrorCode;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
IdGlobal,
|
|
SysUtils;
|
|
|
|
{ TIdReplyRFC }
|
|
|
|
procedure TIdReplyRFC.AssignTo(ADest: TPersistent);
|
|
var
|
|
LR: TIdReplyRFC;
|
|
begin
|
|
if ADest is TIdReplyRFC then begin
|
|
LR := TIdReplyRFC(ADest);
|
|
//set code first as it possibly clears the reply
|
|
LR.NumericCode := NumericCode;
|
|
LR.Text.Assign(Text);
|
|
end else begin
|
|
inherited AssignTo(ADest);
|
|
end;
|
|
end;
|
|
|
|
function TIdReplyRFC.CheckIfCodeIsValid(const ACode: string): Boolean;
|
|
var
|
|
LCode: Integer;
|
|
begin
|
|
LCode := IndyStrToInt(ACode, 0);
|
|
{Replaced 600 with 999 because some developers may want 6xx, 7xx, and 8xx reply
|
|
codes for their protocols. It also turns out that RFC 2228 defines 6xx reply codes.
|
|
|
|
From RFC 2228
|
|
|
|
A new class of reply types (6yz) is also introduced for protected
|
|
replies.
|
|
}
|
|
Result := ((LCode >= 100) and (LCode < 1000)) or (Trim(ACode) = '');
|
|
end;
|
|
|
|
function TIdReplyRFC.GetFormattedReply: TStrings;
|
|
var
|
|
I, LCode: Integer;
|
|
LCodeStr: String;
|
|
begin
|
|
Result := GetFormattedReplyStrings;
|
|
LCode := NumericCode;
|
|
if LCode > 0 then begin
|
|
LCodeStr := IntToStr(LCode);
|
|
if Text.Count > 0 then begin
|
|
for I := 0 to Text.Count - 1 do begin
|
|
if I < Text.Count - 1 then begin
|
|
Result.Add(LCodeStr + '-' + Text[I]);
|
|
end else begin
|
|
Result.Add(LCodeStr + ' ' + Text[I]);
|
|
end;
|
|
end;
|
|
end else begin
|
|
Result.Add(LCodeStr);
|
|
end;
|
|
end else if FText.Count > 0 then begin
|
|
Result.AddStrings(FText);
|
|
end;
|
|
end;
|
|
|
|
class function TIdReplyRFC.IsEndMarker(const ALine: string): Boolean;
|
|
begin
|
|
if Length(ALine) >= 4 then begin
|
|
Result := ALine[4] = ' ';
|
|
end else begin
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdReplyRFC.RaiseReplyError;
|
|
begin
|
|
raise EIdReplyRFCError.CreateError(NumericCode, Text.Text);
|
|
end;
|
|
|
|
function TIdReplyRFC.ReplyExists: Boolean;
|
|
begin
|
|
Result := (NumericCode > 0) or (FText.Count > 0);
|
|
end;
|
|
|
|
procedure TIdReplyRFC.SetFormattedReply(const AValue: TStrings);
|
|
// Just parse and put in items, no need to store after parse
|
|
var
|
|
i: Integer;
|
|
s: string;
|
|
begin
|
|
Clear;
|
|
if AValue.Count > 0 then begin
|
|
s := Trim(Copy(AValue[0], 1, 3));
|
|
Code := s;
|
|
for i := 0 to AValue.Count - 1 do begin
|
|
Text.Add(Copy(AValue[i], 5, MaxInt));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ EIdReplyRFCError }
|
|
|
|
constructor EIdReplyRFCError.CreateError(const AErrorCode: Integer;
|
|
const AReplyMessage: string);
|
|
begin
|
|
inherited Create(AReplyMessage);
|
|
FErrorCode := AErrorCode;
|
|
end;
|
|
|
|
{ TIdReplies }
|
|
|
|
constructor TIdRepliesRFC.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TIdReplyRFC);
|
|
end;
|
|
|
|
constructor TIdRepliesRFC.Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass);
|
|
begin
|
|
inherited Create(AOwner, AReplyClass);
|
|
end;
|
|
|
|
procedure TIdRepliesRFC.UpdateText(AReply: TIdReply);
|
|
var
|
|
LGenericNumCode: Integer;
|
|
LReply: TIdReply;
|
|
begin
|
|
inherited UpdateText(AReply);
|
|
// If text is still blank after inherited see if we can find a generic version
|
|
if AReply.Text.Count = 0 then begin
|
|
LGenericNumCode := (AReply.NumericCode div 100) * 100;
|
|
// RLebeau - in cases where the AReply.Code is the same as the
|
|
// generic code, ignore the AReply as it doesn't have any text
|
|
// to assign, or else the code wouldn't be this far
|
|
LReply := Find(IntToStr(LGenericNumCode), AReply);
|
|
if LReply = nil then begin
|
|
// If no generic was found, then use defaults.
|
|
case LGenericNumCode of
|
|
100: AReply.Text.Text := 'Information'; {do not localize}
|
|
200: AReply.Text.Text := 'Ok'; {do not localize}
|
|
300: AReply.Text.Text := 'Temporary Error'; {do not localize}
|
|
400: AReply.Text.Text := 'Permanent Error'; {do not localize}
|
|
500: AReply.Text.Text := 'Unknown Internal Error'; {do not localize}
|
|
end;
|
|
end else begin
|
|
AReply.Text.Assign(LReply.Text);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|