idreplysmtp.pas

photo.163.com 相册下载器 多线程下载

   //6.2 Conversion required and prohibited
   Id_EHR_MED_CONV_REQUIRED_PROHIB_TRANS = '4.6.2';       {do not localize}
   Id_EHR_MED_CONV_REQUIRED_PROHIB_PERM = '5.6.2';        {do not localize}
   //X.6.3 Conversion required but not supported
   Id_EHR_MED_CONV_REQUIRED_NOT_SUP_TRANS = '4.6.3';      {do not localize}
   Id_EHR_MED_CONV_REQUIRED_NOT_SUP_PERM = '5.6.3';       {do not localize}
   //X.6.4 Conversion with loss performed
   Id_EHR_MED_CONV_LOSS_WARNING = '2.6.4';                {do not localize}
   Id_EHR_MED_CONV_LOSS_ERROR = '5.6.4';                  {do not localize}
   //X.6.5 Conversion Failed
   Id_EHR_MED_CONV_FAILED_TRANS = '4.6.5';                {do not localize}
   Id_EHR_MED_CONV_FAILED_PERM = '5.6.5';                 {do not localize}
   //X.7.0 Other or undefined security status
   Id_EHR_SEC_OTHER_OK = '2.7.0';                         {do not localize}
   Id_EHR_SEC_OTHER_TRANS = '4.7.0';                      {do not localize}
   Id_EHR_SEC_OTHER_PERM = '5.7.0';                       {do not localize}
   //X.7.1 Delivery not authorized, message refused
   Id_EHR_SEC_DEL_NOT_AUTH = '5.7.1';                     {do not localize}
   //X.7.2 Mailing list expansion prohibited
   Id_EHR_SEC_EXP_NOT_AUTH = '5.7.2';                     {do not localize}
   //X.7.3 Security conversion required but not possible
   Id_EHR_SEC_CONV_REQ_NOT_POSSIBLE = '5.7.3';            {do not localize}
   //X.7.4 Security features not supported
   Id_EHR_SEC_NOT_SUPPORTED = '5.7.4';                    {do not localize}
   //X.7.5 Cryptographic failure
   Id_EHR_SEC_CRYPT_FAILURE_TRANS = '4.7.5';              {do not localize}
   Id_EHR_SEC_CRYPT_FAILURE_PERM = '5.7.5';               {do not localize}
   //X.7.6 Cryptographic algorithm not supported
   Id_EHR_SEC_CRYPT_ALG_NOT_SUP_TRANS = '4.7.6';          {do not localize}
   Id_EHR_SEC_CRYPT_ALG_NOT_SUP_PERM = '5.7.6';           {do not localize}
   //X.7.7 Message integrity failure
   Id_EHR_SEC_INTEGRETIY_FAILED_WARN = '2.7.7';           {do not localize}
   Id_EHR_SEC_INTEGRETIY_FAILED_TRANS = '4.7.7';          {do not localize}

implementation

uses
  IdGlobal, IdGlobalProtocols, IdResourceStringsProtocols, SysUtils;

{ TIdSMTPEnhancedCode }

procedure TIdSMTPEnhancedCode.AssignTo(ADest: TPersistent);
var LE : TIdSMTPEnhancedCode;
begin
  if ADest is TIdSMTPEnhancedCode then
  begin
    LE := TIdSMTPEnhancedCode(ADest);
    LE.StatusClass := FStatusClass;
    LE.Subject := FSubject;
    LE.Details := FDetails;
    LE.Available := FAvailable;
  end else begin
    inherited;
  end;
end;

constructor TIdSMTPEnhancedCode.Create;
begin
  inherited Create;
  FStatusClass := CLASS_DEF;
  FSubject := NODETAILS;
  FDetails := NODETAILS;
  FAvailable := AVAIL_DEF;
end;

function TIdSMTPEnhancedCode.GetReplyAsStr: String;
begin
  Result := '';
  if Available then
  begin
    Result := Copy(IntToStr(FStatusClass),1,1)+PARTSEP+
      Copy(IntToStr(FSubject),1,3)+PARTSEP+
      Copy(IntToStr(FDetails),1,3);
  end;
end;

function TIdSMTPEnhancedCode.IsValidReplyCode(const AText: String): Boolean;
var LBuf, LValidPart : String;
begin
  Result := (Trim(AText) = '');
  if not Result then begin
    LBuf := AText;
    LBuf := Fetch(LBuf);
    //class
    LValidPart := Fetch(LBuf,PARTSEP);
    if CharIsInSet(LValidPart, 1, ValidClassChars) then begin
      //subject
      LValidPart := Fetch(LBuf,PARTSEP);
      if (LValidPart<>'') and IsNumeric(LValidPart) then begin
        //details
        Result := (LBuf<>'') and IsNumeric(LBuf);
      end;
    end;
  end;
end;

procedure TIdSMTPEnhancedCode.SetAvailable(const AValue: Boolean);
begin
  if FAvailable <> AValue then
  begin
    FAvailable := AValue;
    if AValue then
    begin
      FStatusClass := CLASS_DEF;
      FSubject := NODETAILS;
      FDetails := NODETAILS;
    end;
  end;
end;

procedure TIdSMTPEnhancedCode.SetReplyAsStr(const AText: String);
var
  LBuf: string;
  LValidPart: string;
begin
  EIdSMTPReplyInvalidReplyString.IfFalse(IsValidReplyCode(AText)
   , RSSMTPReplyInvalidReplyStr);
  LBuf := AText;
  LBuf := Fetch(LBuf);
  if LBuf <> '' then begin
    //class
    LValidPart := Fetch(LBuf, PARTSEP);
    FStatusClass := StrToIntDef(LValidPart, 0);
    //subject
    LValidPart := Fetch(LBuf, PARTSEP);
    FSubject := StrToIntDef(LValidPart,0);
    //details
    FDetails := StrToIntDef(LBuf,0);
    FAvailable := True;
  end else begin
    FAvailable := False;
  end;
end;

procedure TIdSMTPEnhancedCode.SetStatusClass(const AValue: Cardinal);
begin
  if AValue in ValidClassVals then
  begin
    FStatusClass := AValue;
  end
  else
  begin
    raise EIdSMTPReplyInvalidClass.Create(RSSMTPReplyInvalidClass);
  end;
end;

{ TIdReplySMTP }

procedure TIdReplySMTP.AssignTo(ADest: TPersistent);
var LS : TIdReplySMTP;
begin
  if ADest is TIdReplySMTP then
  begin
    LS := ADest as TIdReplySMTP;
    LS.EnhancedCode := FEnhancedCode;
    LS.Text.Assign(FText);
    LS.Code := FCode;
  end else begin
    inherited;
  end;
end;

constructor TIdReplySMTP.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  FEnhancedCode := TIdSMTPEnhancedCode.Create;
end;

constructor TIdReplySMTP.Create( ACollection: TCollection; AReplyTexts: TIdReplies );
begin
  inherited Create(ACollection, AReplyTexts);
  FEnhancedCode := TIdSMTPEnhancedCode.Create;
end;

destructor TIdReplySMTP.Destroy;
begin
  FreeAndNil(FEnhancedCode);
  inherited;
end;

function TIdReplySMTP.GetFormattedReply: TIdStrings;
var
  i: Integer;
begin
  Result := GetFormattedReplyStrings;
{  JP here read from Items and format according to the reply, in this case RFC
  and put it into FFormattedReply   }

  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
          if EnhancedCode.Available then
          begin
            Result.Add( IntToStr(NumericCode) + '-' + EnhancedCode.ReplyAsStr +' '+ FText[i]);
          end
          else
          begin
            Result.Add( IntToStr(NumericCode) + '-' + FText[i]);
          end;
        end else begin
          if EnhancedCode.Available then
          begin
            Result.Add( IntToStr(NumericCode) + ' ' + EnhancedCode.ReplyAsStr +' '+ FText[i]);
          end
          else
          begin
            Result.Add( IntToStr(NumericCode) + ' ' + FText[i]);
          end;
        end;
      end;
    end else begin
      if EnhancedCode.Available then
      begin
        Result.Add( IntToStr(NumericCode) + ' ' + EnhancedCode.ReplyAsStr);
      end
      else
      begin
        Result.Add( IntToStr(NumericCode));
      end;
    end;
  end else if FText.Count > 0 then begin
    Result.AddStrings(FText);
  end;
end;

procedure TIdReplySMTP.RaiseReplyError;
begin
  raise EIdSMTPReplyError.CreateError(NumericCode,FEnhancedCode,Text.Text);
end;

procedure TIdReplySMTP.SetEnhancedCode(AValue: TIdSMTPEnhancedCode);
begin
  FEnhancedCode.Assign(AValue);
end;

procedure TIdReplySMTP.SetEnhReply(const ANumericCode: Integer;
  const AEnhReply, AText: String);
begin
  inherited SetReply(ANumericCode,AText);
  FEnhancedCode.ReplyAsStr := AEnhReply;
end;

procedure TIdReplySMTP.SetFormattedReply(const AValue: TIdStrings);
{  in here 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
    // Get 4 chars - for POP3
    s := Trim(Copy(AValue[0], 1, 4));
    if Length(s) = 4 then begin
      if s[4] = '-' then begin
        SetLength(s, 3);
      end;
    end;
    Code := s;
    for i := 0 to AValue.Count - 1 do begin
      s := Copy(AValue[i], 5, MaxInt);
      if FEnhancedCode.IsValidReplyCode(Fetch(s,' ',False)) then
      begin
        FEnhancedCode.ReplyAsStr := Fetch(s);
      end;
      Text.Add(S);
    end;
  end;
end;

{ TIdRepliesSMTP }

constructor TIdRepliesSMTP.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TIdReplySMTP);
end;

{ EIdSMTPReplyError }

constructor EIdSMTPReplyError.CreateError(const AErrCode: Integer;
  AEnhanced: TIdSMTPEnhancedCode; const AReplyMessage: string);
begin
  inherited CreateError(AErrCode,AReplyMessage);
  FEnhancedCode := TIdSMTPEnhancedCode.Create;
  FEnhancedCode.ReplyAsStr := AEnhanced.ReplyAsStr;
end;

destructor EIdSMTPReplyError.Destroy;
begin
  FreeAndNil(FEnhancedCode);
  inherited;
end;

end.