{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11962: IdReplyRFC.pas 
{
{   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

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;
  published
  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
  IdCoreGlobal,
  SysUtils;

{ TIdReplyRFC }

procedure TIdReplyRFC.AssignTo(ADest: TPersistent);
var
  LR: TIdReplyRFC;
begin

  if ADest is TIdReplyRFC then begin
    LR := TIdReplyRFC(ADest);
    LR.NumericCode := NumericCode;
    LR.FText.Assign(Text);
  end
  else
  begin
    inherited;
  end;
end;

function TIdReplyRFC.CheckIfCodeIsValid(const ACode: string): Boolean;
var
  LCode: Integer;
begin
  LCode := StrToIntDef(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: Integer;
begin
  Result := inherited GetFormattedReply;

  if NumericCode > 0 then begin
    if FText.Count > 0 then begin
      for i := 0 to FText.Count - 1 do begin
        if i < FText.Count - 1 then begin
          Result.Add( IntToStr(NumericCode) + '-' + FText[i]);
        end else begin
          Result.Add( IntToStr(NumericCode) + ' ' + FText[i]);
        end;
      end;
    end else begin
     Result.Add(IntToStr(NumericCode));
    end;
  end else if FText.Count > 0 then begin
    Result.AddStrings(FText);
  end;
end;

class function TIdReplyRFC.IsEndMarker(const ALine: string): Boolean;
begin
  // Use copy not ALine[4] as it might not be long enough for that reference
  // to be valid
  Result := (Length(ALine) < 4) or (Copy(ALine, 4, 1) = ' ');
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;

end.
