Indy/Bubbles/boxtests/EncoderBox.pas

{ $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:  23934: EncoderBox.pas
{
{   Rev 1.1    04/10/2003 15:22:18  CCostelloe
{ Emails generated now have the same date
}
{
{   Rev 1.0    26/09/2003 00:04:08  CCostelloe
{ Initial
}
unit EncoderBox;

interface

{$I IdCompilerDefines.inc}

uses
  IndyBox,
  Classes,
  IdComponent, IdGlobal, IdSocketHandle, IdIntercept, IdMessage, IdMessageClient,
  SysUtils;

type
  TEncoderBox = class(TIndyBox)
  protected
    FExtractPath: string;
    FMsg: TIdMessage;
    FGeneratedStream: TMemoryStream;
    FTestMessageName: string;
  public
    procedure Test; override;
    procedure TestMessage(const APathname: string; const AVerify: Boolean = False;
     const AEmit: Boolean = False);
    //
    property ExtractPath: string read FExtractPath;
    property Msg: TIdMessage read FMsg;
    property GeneratedStream: TMemoryStream read FGeneratedStream;
    property TestMessageName: string read FTestMessageName;
  end;

implementation

uses
  IdMessageCoderMIME, IdMessageCoderUUE, IdPOP3,
  IniFiles, IdText, IdAttachmentFile{$IFDEF VER130},FileCtrl{$ENDIF};

{ TEncoderBox }

procedure TEncoderBox.Test;
var
  i: integer;
  LRec: TSearchRec;
  LPathToSearch: string;
begin
  LPathToSearch := GetDataDir +  '*.ini';
  i := FindFirst(LPathToSearch, faAnyFile, LRec); try
    while i = 0 do begin
      TestMessage(GetDataDir + LRec.Name, True);
      i := FindNext(LRec);
    end;
  finally FindClose(LRec); end;
end;

procedure TEncoderBox.TestMessage(const APathname: string; const AVerify: Boolean = False;
 const AEmit: Boolean = False);
var
  IniParams: TStringList;
  CorrectStream: TFileStream;
  //GeneratedStreamToFile: TFileStream;
  i: Integer;
  sTemp: string;
  sParentPart, sContentType, sType, sEncoding, sFile: string;
  nParentPart: Integer;
  nPos: integer;
  TheTextPart: TIdText;
  {$IFDEF INDY100}
  TheAttachment: TIdAttachmentFile;
  {$ELSE}
  TheAttachment: TIdAttachment;
  {$ENDIF}
  sr: TSearchRec;
  FileAttrs: Integer;

  procedure CompareStream(const AStream1: TStream; const AStream2: TStream; const AMsg: string);
  //var
    //i: integer;
    //LByte1, LByte2: byte;
  begin
    Check(AStream1.Size = AStream2.Size, 'File size mismatch with ' + AMsg);
    //The following always fails for MIME because the random boundary is always different !!!
    {
    for i := 1 to AStream1.Size do begin
      AStream1.ReadBuffer(LByte1, 1);
      AStream2.ReadBuffer(LByte2, 1);
      Check(LByte1 = LByte2, 'Mismatch at byte ' + IntToStr(i) + ', '
       + AMsg);
    end;
    }
  end;

begin
  FTestMessageName := '';
  Status('Testing message ' + ExtractFilename(APathname));

  //Set up path to test directory...
  FExtractPath := ChangeFileExt(APathname, '') + GPathSep;
  ForceDirectories(ExtractPath);
  //Set up the filename of the correct (test) message...
  FTestMessageName := ExtractPath+ChangeFileExt(ExtractFilename(APathname), '.msg');

  //If it is Emit, make sure we will be able to delete the message...
  FileAttrs := 0; //Stop compiler whining it might not have been initialized
  if AEmit then begin
    if FindFirst(FTestMessageName, FileAttrs, sr) = 0 then begin
      if (sr.Attr and faReadOnly) = faReadOnly then begin
        raise EBXCheck.Create('The reference file exists and is read-only, Emit not valid: '+FTestMessageName);
      end;
      FindClose(sr);
    end;
  end;

  FMsg := TIdMessage.Create(Self);
  //Read in the INI settings that define the email we are to generate...
  IniParams := TStringList.Create;
  IniParams.LoadFromFile(APathname);
  //Make sure the date will always be the same, else get different
  //outputs for the Date header...
  FMsg.UseNowForDate := False;
  FMsg.Date := EncodeDate(2011, 11, 11);
  i := 0;
  while IniParams.Values['Body'+IntToStr(i)] <> '' do begin
    FMsg.Body.Add(IniParams.Values['Body'+IntToStr(i)]);
    Inc(i);
  end;
  FMsg.ContentTransferEncoding := IniParams.Values['ContentTransferEncoding'];
  if IniParams.Values['ConvertPreamble'] = 'True' then begin
    FMsg.ConvertPreamble := True;
  end else if IniParams.Values['ConvertPreamble'] = 'False' then begin
    FMsg.ConvertPreamble := False;
  end;
  if IniParams.Values['Encoding'] = 'meMIME' then begin
    FMsg.Encoding := meMIME;
  end else if IniParams.Values['Encoding'] = 'meUU' then begin
    FMsg.Encoding := meUU;
  end else if IniParams.Values['Encoding'] = 'meXX' then begin
    FMsg.Encoding := meXX;
  end;
  if IniParams.Values['ContentType'] <> '' then begin
    FMsg.ContentType := IniParams.Values['ContentType'];
  end;
  i := 0;
  while IniParams.Values['Part'+IntToStr(i)] <> '' do begin
    sTemp := IniParams.Values['Part'+IntToStr(i)];
    nPos := Pos(',', sTemp);
    sType := Copy(sTemp, 1, nPos-1);
    sTemp := Copy(sTemp, nPos+1, MAXINT);
    nPos := Pos(',', sTemp);
    sEncoding := Copy(sTemp, 1, nPos-1);
    sFile := Copy(sTemp, nPos+1, MAXINT);
    nParentPart := -999;
    nPos := Pos(',', sFile);
    if nPos > 0 then begin  //ParentPart, ContentType optional
        sTemp := Copy(sFile, nPos+1, MAXINT);
        sFile := Copy(sFile, 1, nPos-1);
        nPos := Pos(',', sTemp);
        sContentType := Copy(sTemp, nPos+1, MAXINT);
        sParentPart := Copy(sTemp, 1, nPos-1);
        nParentPart := StrToInt(sParentPart);
    end;
    if sType = 'TIdText' then begin
        TheTextPart := TIdText.Create(FMsg.MessageParts);
        TheTextPart.Body.LoadFromFile(sFile);
        if sEncoding <> 'Default' then TheTextPart.ContentTransfer := sEncoding;
        if ((sContentType <> '') and (sContentType <> 'Default')) then TheTextPart.ContentType := sContentType;
        {$IFDEF INDY100}
        if nParentPart <> -999 then TheTextPart.ParentPart := nParentPart;
        {$ENDIF}
    end else begin
        {$IFDEF INDY100}
        TheAttachment := TIdAttachmentFile.Create(FMsg.MessageParts, sFile);
        {$ELSE}
        TheAttachment := TIdAttachment.Create(FMsg.MessageParts, sFile);
        {$ENDIF}
        if sEncoding <> 'Default' then TheAttachment.ContentTransfer := sEncoding;
        if ((sContentType <> '') and (sContentType <> 'Default')) then TheAttachment.ContentType := sContentType;
        {$IFDEF INDY100}
        if nParentPart <> -999 then TheAttachment.ParentPart := nParentPart;
        {$ENDIF}
    end;
    Inc(i);
  end;
  //Do the test...
  FGeneratedStream := TMemoryStream.Create;
  FMsg.SaveToStream(FGeneratedStream);
  //Compare the results...
  try
    if AEmit then begin
      GeneratedStream.Seek(0, soFromBeginning);
      GeneratedStream.SaveToFile(TestMessageName);
    end else if AVerify then begin
      Check(FileExists(TestMessageName) = True, 'Missing correct result file '+TestMessageName);
      CorrectStream := TFileStream.Create(TestMessageName, fmOpenRead);
      GeneratedStream.Seek(0, soFromBeginning);
      CompareStream(GeneratedStream, CorrectStream, ExtractFilename(APathname));
    end;
  finally FreeAndNil(CorrectStream); end;
  Status('Message encoded.');
end;

initialization
  TIndyBox.RegisterBox(TEncoderBox, 'Emails', 'Encoders');
end.