{******************************************************************}
{*               IPMSG.PAS - MIME message classes                 *}
{******************************************************************}

{ $Id$ }

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Internet Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * Markus Kaemmerer <mk@happyarts.de> SourceForge: mkaemmerer
 *
 * ***** END LICENSE BLOCK ***** *)

{ Global defines potentially affecting this unit }

{$I IPDEFINE.INC}

unit IpMsg;

interface

uses
  {$IFDEF IP_LAZARUS}
  LCLType,
  LCLIntf,
  LazFileUtils, LazUTF8Classes,
  {$ELSE}
  Windows,
  {$ENDIF}
  Classes,
  SysUtils,
  IpStrms,
  {$IFNDEF IP_LAZARUS}
  //IpSock, //JMN
  {$ENDIF}
  IpUtils,
  IpConst;

type
  TIpMimeEncodingMethod = (em7Bit, em8Bit, emBase64, emBinary, emBinHex,
                           emQuoted, emUUEncode, emUnknown);


{ TIpMimeEntity }
type
  TIpCodingProgressEvent = procedure(Sender : TObject; Progress : Byte;
                                     var Abort : Boolean) of object;

{Begin !!.12}
type
  TIpHeaderTypes = (htBCC, htCC, htControl, htDate, htDispositionNotify,
                    htFollowUp, htFrom, htInReplyTo, htKeywords,
                    htMessageID, htNewsgroups, htNNTPPostingHost,
                    htOrganization, htPath, htPostingHost, htReceived,
                    htReferences, htReplyTo, htReturnPath, htSender,
                    htSubject, htTo, htUserFields, htXIpro);

  TIpHeaderInfo = record
    FieldType   : TIpHeaderTypes;
    FieldString : string;
  end;

const
  IpMaxHeaders = 24;

  IpHeaderXRef : array [0..IpMaxHeaders - 1] of  TIpHeaderInfo =
    ((FieldType : htBCC;               FieldString : 'BCC'),
     (FieldType : htCC;                FieldString : 'CC'),
     (FieldType : htControl;           FieldString : 'Control: '),
     (FieldType : htDate;              FieldString : 'Date'),
     (FieldType : htDispositionNotify; FieldString : 'Disposition-Notification-To'),
     (FieldType : htFollowUp;          FieldString : 'Followup-To: '),
     (FieldType : htFrom;              FieldString : 'From'),
     (FieldType : htInReplyTo;         FieldString : 'In-Reply-To'),
     (FieldType : htKeywords;          FieldString : 'Keywords'),
     (FieldType : htMessageID;         FieldString : 'Message-ID'),
     (FieldType : htNewsgroups;        FieldString : 'Newsgroups'),
     (FieldType : htNNTPPostingHost;   FieldString : 'NNTP-Posting-Host'),
     (FieldType : htOrganization;      FieldString : 'Organization'),
     (FieldType : htPath;              FieldString : 'Path'),
     (FieldType : htPostingHost;       FieldString : 'Posting-Host'),
     (FieldType : htReceived;          FieldString : 'Received'),
     (FieldType : htReferences;        FieldString : 'References'),
     (FieldType : htReplyTo;           FieldString : 'Reply-To'),
     (FieldType : htReturnPath;        FieldString : 'Return-Path'),
     (FieldType : htSender;            FieldString : 'Sender'),
     (FieldType : htSubject;           FieldString : 'Subject'),
     (FieldType : htTo;                FieldString : 'To'),
     (FieldType : htUserFields;        FieldString : 'X-'),
     (FieldType : htXIpro;             FieldString : 'X-Ipro'));

type
  TIpHeaderCollection = class;

  TIpHeaderItem = class (TCollectionItem)
    private
      FCollection  : TIpHeaderCollection;
      FName        : string;
      FNameL       : string;
        { Lower case version of FName. Used to speed up header searches. }
      FProperty    : Boolean;                                          {!!.13}
      FValue       : TStringList;
    protected
      procedure SetName(const Name : string);
      procedure SetValue (v : TStringList);
    public
      constructor Create (Collection : TCollection); override;
      destructor Destroy; override;
    published
      property Collection : TIpHeaderCollection
               read FCollection write FCollection;
      property Name : string read FName write SetName;
      property NameL : string read FNameL;
        { Lower case version of Name property. }
      property IsProperty : Boolean read FProperty write FProperty;    {!!.13}
        { Set to True if this header is exposed via an iPRO property. }{!!.13}
      property Value : TStringList read FValue write SetValue;
  end;

  TIpHeaderCollection = class (TCollection)
    private
      FOwner : TPersistent;                                              

    protected                                                            
      function GetItem (Index : Integer) : TIpHeaderItem;
      function GetOwner : TPersistent; override;                         
      procedure SetItem (Index : Integer; Value : TIpHeaderItem);        

    public                                                               
      constructor Create (AOwner : TPersistent);                         

      {$IFNDEF VERSION5}                                                 
      procedure Delete (Item : integer);                                 
      {$ENDIF}
      function HasHeader (AName : string) : Integer;
      procedure HeaderByName (AName   : string;
                              Headers : TStringList);
      procedure LoadHeaders (AHeaderList : TStringList;                  
                             Append      : Boolean);                     

      property Items[Index : Integer] : TIpHeaderItem                    
               read GetItem write SetItem;                               
  end;                                                                   
{End !!.12}

  TIpMimeParts = class; { Forwards }

  TIpMimeEntity = class(TPersistent)
  protected {private}
    FProgress                : Byte;
    PrevProgress             : Byte;
    FMimeParts               : TIpMimeParts;
    FParentBoundary          : string;
    FBody                    : TIpAnsiTextStream;
    FEntityName              : string;
    FBoundary                : string;
    FCharacterSet            : string;
    FContentDescription      : string;
    FContentDispositionType  : string;
    FContentID               : string;
    FContentSubtype          : string;
    FContentType             : string;
    FCreationDate            : string;
    FContentTransferEncoding : TIpMimeEncodingMethod;
    FFileName                : string;
    FIsMime                  : Boolean;
    FIsMultipart             : Boolean;
    FModificationDate        : string;
    FMimeVersion             : string;
    FOnCodingProgress        : TIpCodingProgressEvent;
    FOriginalSize            : Longint;
    FParent                  : TIpMimeEntity;
    FReadDate                : string;
    FRelatedType             : string;                                 {!!.02}
    FRelatedSubtype          : string;                                 {!!.02}
    FRelatedStart            : string;                                 {!!.02}
    FRelatedStartInfo        : string;                                 {!!.02}
    FAttachmentCount         : Integer;                                {!!.12}

  protected {methods}
    procedure Clear; virtual;
    procedure ClearBodyLargeAttach(const AttachmentSize : Longint); virtual;  {!!.12}
    function  ContainsSpecialChars(const Value : string) : Boolean;    {!!.14}
    procedure DecodeContentDisposition(const aDisp : string);
    procedure DecodeContentType(const aType : string);
    function  DecodeContentTransferEncoding(const aEncoding : string) :
                                            TIpMimeEncodingMethod;
    procedure DecodeMimeHeaders(RawHeaders : TStringlist);
    procedure DoOnCodingProgress(Count, TotalSize : Longint; var Abort : Boolean);
    procedure EncodeContentDisposition(RawHeaders : TStringList);
    procedure EncodeContentType(RawHeaders : TStringList);
    procedure EncodeContentTransferEncoding(RawHeaders : TStringList);
    procedure EncodeMimeHeaders(RawHeaders : TStringlist);
    procedure OctetStreamToHextetStream(InStream : TStream; OutStream : TIpAnsiTextStream;
                                        const Table; PadChar, Delim : AnsiChar);
    procedure Decode8Bit(OutStream : TStream);
    procedure DecodeBase64(OutStream : TStream);
    procedure DecodeBinHex(OutStream : TStream);
    procedure DecodeQuoted(OutStream : TStream);
    procedure DecodeUUEncode(OutStream : TStream);
    procedure Encode8Bit(InStream : TStream);
    procedure EncodeBase64(InStream : TStream);
    procedure EncodeBinHex(InStream : TStream; const aFileName : string);
    procedure EncodeQuoted(InStream : TStream);
    procedure EncodeUUEncode(InStream : TStream; const aFileName : string);
    function DecodeEntity(InStream : TIpAnsiTextStream) : string;
    function DecodeEntityAsAttachment(InStream : TIpAnsiTextStream) : string;  {!!.01}
    function EncodeEntity(OutStream : TIpAnsiTextStream) : string;
    procedure ReadBody(InStream : TIpAnsiTextStream; const StartLine : string); {!!.12}

  protected {properties}
    property OnCodingProgress : TIpCodingProgressEvent
      read FOnCodingProgress write FOnCodingProgress;

  public {methods}
    constructor Create(ParentEntity : TIpMimeEntity); virtual;
    destructor  Destroy; override;
    procedure ClearBody;
    procedure EncodeBodyFile(const InFile : string);
    procedure EncodeBodyStream(InStream : TStream; const aFileName : string);
    procedure EncodeBodyStrings(InStrings : TStrings; const aFileName : string);
    procedure ExtractBodyFile(const OutFile : string);
    procedure ExtractBodyStream(OutStream : TStream);
    procedure ExtractBodyStrings(OutStrings : TStrings);
    function FindNestedMimePart(const aType, aSubType, aContentID : string) : TIpMimeEntity; {!!.02}
    function  GetMimePart(const aType, aSubType, aContentID : string;
                              CanCreate : Boolean) : TIpMimeEntity;
    function  NewMimePart : TIpMimeEntity;

    property AttachmentCount : Integer read FAttachmentCount;          {!!.12}

  public {properties}
    property Body : TIpAnsiTextStream
      read FBody;

    property Boundary : string
      read FBoundary write FBoundary;

    property CharacterSet : string
      read FCharacterSet write FCharacterSet;

    property ContentDescription : string
      read FContentDescription write FContentDescription;

    property ContentDispositionType : string
      read FContentDispositionType write FContentDispositionType;

    property ContentID : string
      read FContentID write FContentID;

    property ContentSubtype : string
      read FContentSubtype write FContentSubtype;

    property ContentTransferEncoding : TIpMimeEncodingMethod
      read FContentTransferEncoding write FContentTransferEncoding;

    property ContentType : string
      read FContentType write FContentType;

    property CreationDate : string
      read FCreationDate write FCreationDate;

    property EntityName : string
      read FEntityName write FEntityName;

    property FileName : string
      read FFileName write FFileName;

    property IsMime : Boolean
      read FIsMime;

    property IsMultipart : Boolean
      read FIsMultipart;

    property MimeParts : TIpMimeParts
      read FMimeParts;

    property MimeVersion : string
      read FMimeVersion write FMimeVersion;

    property ModificationDate : string
      read FModificationDate write FModificationDate;

    property OriginalSize : Longint
      read FOriginalSize write FOriginalSize;

    property Parent : TIpMimeEntity
      read FParent;

    property ReadDate : string
      read FReadDate write FReadDate;

    property RelatedStart : string                                   {!!.02}
      read FRelatedStart write FRelatedStart;

    property RelatedStartInfo : string                               {!!.02}
      read FRelatedStartInfo write FRelatedStartInfo;

    property RelatedSubtype : string                                 {!!.02}
      read FRelatedSubtype write FRelatedSubtype;

    property RelatedType : string                                    {!!.02}
      read FRelatedType write FRelatedType;

  end;


{ TIpMimeParts }
  TIpMimeParts = class
  protected {private}
    Entitys : TList;
    function GetCount : Integer;
    function GetPart(aIndex : Integer) : TIpMimeEntity;
  public {methods}
    constructor Create;
    destructor  Destroy; override;
    function Add(aEntity : TIpMimeEntity) : Integer;
    function Remove(aEntity : TIpMimeEntity) : Integer;
    procedure Clear;
    procedure Delete(aIndex : Integer);
    function IndexOf(aEntity : TIpMimeEntity) : Integer;
  public {properties}
    property Count : Integer
      read GetCount;
    property Parts[aIndex : Integer] : TIpMimeEntity
      read GetPart; default;
  end;


{ TIpMessage }
type
  TIpMessage = class(TIpMimeEntity)
  protected {private}
    MsgStream : TIpAnsiTextStream;

  protected {property variables}
    FBCC             : TStringList;
    FCC              : TStringList;
    FDate            : string;
    FFrom            : string;
    FInReplyTo       : string;
    FKeywords        : string;
    FFollowupTo      : string;                                           {!!.12}
    FControl         : string;                                           {!!.12}
    FMessageID       : string;
    FMessageTag      : Integer;
    FNewsgroups      : TStringList;
    FNNTPPostingHost : string;
    FOrganization    : string;
    FPath            : TStringList;
    FPostingHost     : string;
    FReceived        : TStringList;
    FRecipients      : TStringList;
    FReferences      : TStringList;
    FReplyTo         : string;
    FReturnPath      : string;
    FSender          : string;
    FSubject         : string;
    FUserFields      : TStringList;
    FHeaders         : TIpHeaderCollection;                              {!!.12}
    FDispositionNotify: string;

  protected {methods}
    procedure CheckAllHeaders;                                           {!!.12}
    procedure CheckHeaderType (HeaderInfo : TIpHeaderItem;               {!!.12}
                               HeaderType : TIpHeaderTypes);             {!!.12}
    procedure Clear; override;
    procedure NewMessageStream;
    function  GetPosition : Longint;
    function  GetSize : Longint;
    procedure SetPosition(Value : Longint);
    procedure SetBCC(const Value: TStringList);
    procedure SetCC(const Value: TStringList);
    procedure SetNewsgroups(const Value: TStringList);
    procedure SetPath(const Value: TStringList);
    procedure SetReceived(const Value: TStringList);
    procedure SetRecipients(const Value: TStringList);
    procedure SetReferences(const Value: TStringlist);
    procedure SetUserFields(const Value: TStringList);

  public {methods}
    constructor CreateMessage; virtual;
    destructor  Destroy; override;

    procedure AddDefaultAttachment(const aFileName : string);          {!!.02}
    procedure AddDefaultAttachmentAs (const aFileName      : string;   {!!.12}
                                      const AttachmentName : string);  {!!.12}
    procedure Assign(Source : TPersistent); override;
    function  AtEndOfStream : Boolean;
    procedure DecodeMessage; virtual;
    procedure EncodeMessage; virtual;
    function  GetBodyHtml(CanCreate : Boolean) : TIpMimeEntity;
    function  GetBodyPlain(CanCreate : Boolean) : TIpMimeEntity;
    procedure LoadFromFile(const aFileName : string);
    procedure LoadFromStream(aStream : TStream);                       {!!.12}
    procedure NewMessage;
    function  ReadLine : string;
    function  ReadLineCRLF : string;
    procedure SaveToFile(const aFileName : string);
    procedure SaveToStream(Stream: TStream);                           {!!.12}
    procedure SetHeaders(Headers : TIpHeaderCollection);               {!!.12}
    procedure WriteLine(const aSt : string);

  public {properties}
    property BCC : TStringList
      read FBCC write SetBCC;                                          {!!.01}

    property CC : TStringList
      read FCC write SetCC;                                            {!!.01}

    property Control : string                                          {!!.12}
      read FControl write FControl;                                    {!!.12}

    property Date : string
      read FDate write FDate;

    property DispositionNotification : string                          {!!.12}
      read FDispositionNotify write FDispositionNotify;                {!!.12}

    property FollowupTo : String                                       {!!.12}
      read FFollowupTo Write FFollowupTo;                              {!!.12}

    property From : string
      read FFrom write FFrom;

    property Headers : TIpHeaderCollection                             {!!.12}
             read FHeaders write SetHeaders;                           {!!.12}

    property InReplyTo : string
      read FInReplyTo write FInReplyTo;

    property Keywords : string
      read FKeywords write FKeywords;

    property MessageID : string
      read FMessageID write FMessageID;

    property MessageStream : TIpAnsiTextStream                         {!!.03}
      read MsgStream;                                                  {!!.03}

    property MessageTag : Integer
      read FMessageTag write FMessageTag;

    property Newsgroups : TStringList
      read FNewsgroups write SetNewsgroups;                            {!!.01}

    property NNTPPostingHost : string
      read FNNTPPostingHost write FNNTPPostingHost;

    property Organization : string
      read FOrganization write FOrganization;

    property Path : TStringList
      read FPath write SetPath;                                        {!!.01}

    property Position : Longint
      read GetPosition write SetPosition;

    property PostingHost : string
      read FPostingHost write FPostingHost;

    property Received : TStringList
      read FReceived write SetReceived;                                {!!.01}

    property Recipients : TStringList
      read FRecipients write SetRecipients;                            {!!.01}

    property References : TStringlist
      read FReferences write SetReferences;                            {!!.01}

    property ReplyTo : string
      read FReplyTo write FReplyTo;

    property ReturnPath : string
      read FReturnPath write FReturnPath;

    property Sender : string
      read FSender write FSender;

    property Size : Longint
      read GetSize;

    property Subject : string
      read FSubject write FSubject;

    property UserFields : TStringList
      read FUserFields write SetUserFields;                            {!!.01}

  end;


{ TIpMailMessage}
type
  TIpMailMessage = class(TIpMessage)
  published {properties}
    property BCC;
    property CC;
    property ContentDescription;
    property ContentTransferEncoding;
    property ContentType;
    property Date;
    property From;
    property Keywords;
    property MailTo : TStringList
      read FRecipients write SetRecipients;                            {!!.01}
    property OnCodingProgress;
    property References;
    property ReplyTo;
    property Sender;
    property Subject;
    property UserFields;
end;


{ TIpNewsArticle }
type
  TIpNewsArticle = class(TIpMessage)
  published {properties}
    property ContentDescription;
    property ContentTransferEncoding;
    property ContentType;
    property Date;
    property From;
    property Keywords;
    property Newsgroups;
    property NNTPPostingHost;
    property OnCodingProgress;
    property Path;
    property References;
    property ReplyTo;
    property Sender;
    property Subject;
    property UserFields;
end;


{ TIpFormDataEntity }
type
  TIpFormDataEntity = class(TIpMimeEntity)
  protected
    FFilesEntity : TIpMimeEntity;
  public {methods}
    constructor Create(ParentEntity : TIpMimeEntity); override;
    destructor  Destroy; override;
    procedure AddFormData(const aName, aText : string);
    procedure AddFile(const aFileName, aContentType, aSubtype : string;
                      aEncoding : TIpMimeEncodingMethod);
    procedure SaveToStream(aStream : TStream);
  end;

 {$IFNDEF IP_LAZARUS}
 { dummy class so this unit will be added to the uses clause when an }
 { IpPop3Client, IpSmtpClient or IpNntpClient component is dropped on the form }
 (*** //JMN
 TIpCustomEmailClass = class(TIpCustomClient)
 end;
 **)
 {$ENDIF}

function IpBase64EncodeString(const InStr: string): string;       {!!.02}{!!.03}

{Begin !!.12}
const
  IpLgAttachSizeBoundry = 5 * 1024 * 1024;
    { Attachments over this size will be encoded using a TIpMemMapStream for
      greatly improved performance. This boundary also applies to the final
      encoding of messages with large attachments. }

implementation

const
  { standard headers }
  strBCC               = 'BCC: ';
  strCC                = 'CC: ';
  strDate              = 'Date: ';
  strDispositionNotify = 'Disposition-Notification-To: ';
  strFrom              = 'From: ';
  strInReplyTo         = 'In-Reply-To: ';
  strKeywords          = 'Keywords: ';
  strMessageID         = 'Message-ID: ';
  strNewsgroups        = 'Newsgroups: ';
  strNNTPPostingHost   = 'NNTP-Posting-Host: ';
  strOrganization      = 'Organization: ';
  strPath              = 'Path: ';
  strPostingHost       = 'Posting-Host: ';
  strReceived          = 'Received: ';
  strReferences        = 'References: ';
  strReplyTo           = 'Reply-To: ';
  strReturnPath        = 'Return-Path: ';
  strSender            = 'Sender: ';
  strSubject           = 'Subject: ';
  strTo                = 'To: ';
  strUserFields        = 'X-';
  strXIpro             = 'X-Ipro: ';
  strFollowUp          = 'Followup-To: ';                               {!!.12}
  strControl           = 'Control: ';                                   {!!.12}

{Begin !!.13}
  IpMimeHeaders : array [0..5] of string =
    { List of MIME headers that must be marked as public properties in
      the message's Headers collection. Marking them as a public property
      prevents them from being written out twice if the message is saved
      to a file or stream. }
    (
      'Content-Type',
      'MIME-Version',
      'Content-Transfer-Encoding',
      'Content-Description',
      'Content-ID',
      'Content-Disposition'
    );
{End !!.13}

  { MIME headers }
  strMimeVersion             = 'MIME-Version: ';
  strContent                 = 'Content-';
  strContentBase             = strContent + 'Base: ';
  strContentDescription      = strContent + 'Description: ';
  strContentDisposition      = strContent + 'Disposition: ';
  strContentID               = strContent + 'ID: ';
  strContentLanguage         = strContent + 'Language: ';
  strContentLocation         = strContent + 'Location: ';
  strContentTransferEncoding = strContent + 'Transfer-Encoding: ';
  strContentType             = strContent + 'Type: ';

  { MIME content types }
  strApplication = 'application';
  strAudio       = 'audio';
  strFiles       = 'files';
  strFormData    = 'form-data';
  strImage       = 'image';
  strMessage     = 'message';
  strMultiPart   = 'multipart';
  strText        = 'text';
  strVideo       = 'video';

  { MIME content subtypes and parameters }
  strBoundary    = 'boundary=';
  strCharSet     = 'charset=';
  strMixed       = 'mixed';
  strName        = 'name=';
  strPlain       = 'plain';
  strHTML        = 'html';
  strOctetStream = 'octet-stream';
  strAlternative = 'alternative';
  strRelated     = 'related';                                        {!!.02}

  { MIME content disposition parameters }
  strAttachment       = 'attachment';
  strInline           = 'inline';
  strCreationDate     = 'creation-date=';
  strFilename         = 'filename=';
  strModificationDate = 'modification-date=';
  strReadDate         = 'read-date=';
  strStart            = 'start=';                                    {!!.02}
  strStartInfo        = 'start-info=';                               {!!.02}
  strSize             = 'size=';
  strType             = 'type=';                                     {!!.02}


  { MIME encoding methods }
  str7Bit     = '7bit';
  str8Bit     = '8bit';
  strBase64   = 'base64';
  strBinary   = 'binary';
  strBinHex   = 'binhex';
  strQuoted   = 'quoted-printable';
  strUUEncode = 'uuencoded';


  { default MIME content type information }
{$I IPDEFCT.INC}

type
  TIp6BitTable = array[0..63] of AnsiChar;

const {- BinHex encoding table }
  IpBinHexTable : TIp6BitTable = (
    '!', '"', '#', '$', '%', '&', '''', '(',
    ')', '*', '+', ',', '-', '0', '1',  '2',
    '3', '4', '5', '6', '8', '9', '@',  'A',
    'B', 'C', 'D', 'E', 'F', 'G', 'H',  'I',
    'J', 'K', 'L', 'M', 'N', 'P', 'Q',  'R',
    'S', 'T', 'U', 'V', 'X', 'Y', 'Z',  '[',
    '`', 'a', 'b', 'c', 'd', 'e', 'f',  'h',
    'i', 'j', 'k', 'l', 'm', 'p', 'q',  'r');

const {-BinHex decoding table }
  IpHexBinTable : array[33..114] of Byte = (
    $00, $01, $02, $03, $04, $05, $06, $07,
    $08, $09, $0A, $0B, $0C, $FF, $FF, $0D,
    $0E, $0F, $10, $11, $12, $13, $FF, $14,
    $15, $FF, $FF, $FF, $FF, $FF, $FF, $16,
    $17, $18, $19, $1A, $1B, $1C, $1D, $1E,
    $1F, $20, $21, $22, $23, $24, $FF, $25,
    $26, $27, $28, $29, $2A, $2B, $FF, $2C,
    $2D, $2E, $2F, $FF, $FF, $FF, $FF, $30,
    $31, $32, $33, $34, $35, $36, $FF, $37,
    $38, $39, $3A, $3B, $3C, $FF, $FF, $3D,
    $3E, $3F);

const { Base64 encoding table }
  Ip64Table : TIp6BitTable = (
    #065, #066, #067, #068, #069, #070, #071, #072,
    #073, #074, #075, #076, #077, #078, #079, #080,
    #081, #082, #083, #084, #085, #086, #087, #088,
    #089, #090, #097, #098, #099, #100, #101, #102,
    #103, #104, #105, #106, #107, #108, #109, #110,
    #111, #112, #113, #114, #115, #116, #117, #118,
    #119, #120, #121, #122, #048, #049, #050, #051,
    #052, #053, #054, #055, #056, #057, #043, #047);

const { Base64 decoding table }
  IpD64Table : array[#43..#122] of Byte = (                          {!!.12}
    $3E, $7F, $7F, $7F, $3F, $34, $35, $36,
    $37, $38, $39, $3A, $3B, $3C, $3D, $7F,
    $7F, $7F, $7F, $7F, $7F, $7F, $00, $01,
    $02, $03, $04, $05, $06, $07, $08, $09,
    $0A, $0B, $0C, $0D, $0E, $0F, $10, $11,
    $12, $13, $14, $15, $16, $17, $18, $19,
    $7F, $7F, $7F, $7F, $7F, $7F, $1A, $1B,
    $1C, $1D, $1E, $1F, $20, $21, $22, $23,
    $24, $25, $26, $27, $28, $29, $2A, $2B,
    $2C, $2D, $2E, $2F, $30, $31, $32, $33);

const { UUEncode encoding table }
  IpUUTable : TIp6BitTable = (
    #96, #33, #34, #35, #36, #37, #38, #39,
    #40, #41, #42, #43, #44, #45, #46, #47,
    #48, #49, #50, #51, #52, #53, #54, #55,
    #56, #57, #58, #59, #60, #61, #62, #63,
    #64, #65, #66, #67, #68, #69, #70, #71,
    #72, #73, #74, #75, #76, #77, #78, #79,
    #80, #81, #82, #83, #84, #85, #86, #87,
    #88, #89, #90, #91, #92, #93, #94, #95);

const
  HexDigits : array[0..$F] of AnsiChar = '0123456789ABCDEF';
  RLEChar : Byte = $90;
  BinHexFileType : array[0..3] of Byte = ($49, $42, $4D, $3F);  { "IBM?" }
  CRLF = #13#10;
  MaxLine = 1000;                                                       {!!.12}
  MaxLineEncode = 77;                                                   {!!.13}
    { Maximum line length for QuotablePrintable & Base64 encoding. }    {!!.13}

type
  BinHexHeader = packed record
    Version  : Byte;
    FileType : array[0..3] of Byte;
    Creator  : array[0..3] of Byte;
    Flags    : Word;
    DFLong   : Longint;
    RFLong   : Longint;
  end;

function IsSameString (Str1          : string;                           {!!.12}
                       Str2          : string;                           {!!.12}
                       CaseSensitive : Boolean) : Boolean;               {!!.12}
begin                                                                    {!!.12}
  if CaseSensitive then                                                  {!!.12}
    Result := (Str1 = Str2)                                              {!!.12}
  else                                                                   {!!.12}
    Result := StrIComp (PChar (Str1), PChar (Str2)) = 0;                 {!!.12}
end;                                                                     {!!.12}

{ Parse string into string list }
procedure Parse(const Line : string; Delim : AnsiChar; var List : TStringList);
var
  iPos, jPos : Integer;
  Term : string;
begin
  iPos := 1;
  jPos := IpUtils.CharPos(Delim, Line);
  while (jPos > 0) do begin
    Term := Copy(Line, iPos, jPos - iPos);                           {!!.02}
    if (Term <> '') then
      List.Add(Trim(Term));
    iPos := jPos + 1;
    jPos := IpUtils.CharPosIdx(Delim, Line, iPos);
  end;
  if (iPos < Length(Line)) then
     List.Add(Trim(Copy(Line, iPos, Length(Line))));
end;

{ Return a particular parameter from a parsed header parameter list }
procedure DecodeSingleParameter(const ParamName : string;
                                RawParams : TStringList;
                                var ParamFieldStr : string);
var
  S : string;
  i, j : Integer;
begin
  ParamFieldStr := '';
  {find the line containing the parameter field name}
  for i := 1 to RawParams.Count do begin
    S := RawParams[i-1];
    if StrLIComp(PChar(ParamName), PChar(S), Length(ParamName)) = 0 then begin
      {strip off the parameter field name and remove quotes }
      ParamFieldStr := Copy(S, Length(ParamName) + 1, Length(S));
      j := IpUtils.CharPos('"', ParamFieldStr);
      while (j > 0) do begin
        Delete(ParamFieldStr, j, 1);
        j := IpUtils.CharPos('"', ParamFieldStr);
      end;
      Break;
    end;
  end;
end;

{ Return a particular header as string }
procedure DecodeSingleHeader(const HeaderName : string;
                             RawHeaders : TStringList;
                             var HeaderFieldStr : string);
var
  S, S2 : string;
  i, j : Integer;
begin
  HeaderFieldStr := '';
  {find the line containing the header field name}
  for i := 1 to RawHeaders.Count do begin
    S := RawHeaders[i-1];
    if StrLIComp(PChar(HeaderName), PChar(S), Length(HeaderName)) = 0 then begin
      {strip off the header field name}
      S := Copy(S, Length(HeaderName) + 1, Length(S));
      {unfold the header if continued on more than one line}
      if (i < RawHeaders.Count) then
        for j := i to Pred(RawHeaders.Count) do begin
          S2 := RawHeaders[j];
          if (Length(S2) > 0) and (S2[1] <> #09) and (S2[1] <> ' ') then
            Break
          else
            S := S + S2;
        end;
      HeaderFieldStr := S;
      Break;
    end;
  end;
end;

{ Return a particular header as string list }
(*procedure DecodeListHeader(const HeaderName : string;
                           RawHeaders, HeaderFieldList : TStringList);
var
  S : string;
  i, j : Integer;
begin
  {find the line containing the header field name}
  for i := 1 to RawHeaders.Count do begin
    S := RawHeaders[i-1];
    if StrLIComp(PChar(HeaderName), PChar(S), Length(HeaderName)) = 0 then begin
      {strip off the header field name}
      HeaderFieldList.Add(Copy(S, Length(HeaderName) + 1, Length(S)));
      {unfold the header if continued on more than one line}
      if (i < RawHeaders.Count) then
        for j := i to Pred(RawHeaders.Count) do begin
          S := RawHeaders[j];
          if (Length(S) > 0) and (S[1] <> #09) and (S[1] <> ' ') then
            Break
          else
            HeaderFieldList.Add(S);
        end;
      Break;
    end;
  end;
end;*)

{ Return multiple instance headers as string list }
(*procedure DecodeMultiHeader(const HeaderName : string;
                            RawHeaders, HeaderFieldList : TStringList);

var
  S, S2 : string;
  i, j : Integer;
begin
  {find the next line containing the header field name}
  for i := 1 to RawHeaders.Count do begin
    S := RawHeaders[i-1];
    if StrLIComp(PChar(HeaderName), PChar(S), Length(HeaderName)) = 0 then begin
      if HeaderName <> strUserFields then begin                         {!!.11}
        {strip off the header field name}
        S := Copy(S, Length(HeaderName) + 1, Length(S));
        {unfold the header if continued on more than one line}
        if (i < RawHeaders.Count) then
          for j := i to Pred(RawHeaders.Count) do begin
            S2 := RawHeaders[j];
            if (Length(S2) > 0) and (S2[1] <> #09) and (S2[1] <> ' ') then
              Break
            else
              S := S + S2;
          end;
      end;                                                              {!!.11}
      HeaderFieldList.Add(S);
    end;
  end;
end;*)

{ Add header string to raw headers }
procedure EncodeSingleHeader(const HeaderName : string;
                             RawHeaders : TStringList;
                             HeaderFieldStr : string);
begin
  if (HeaderFieldStr <> '') then
    RawHeaders.Add(HeaderName + HeaderFieldStr);
end;

{ Unfold multiple line header and add to raw headers }
procedure EncodeListHeader(const HeaderName : string;
                           RawHeaders, HeaderFieldList : TStringList;
                           const Delim : string;
                           Fold : Boolean);
var
  S : string;
  i : Integer;
begin
  if (HeaderFieldList.Count > 0) then begin
    S := HeaderName;
    for i := 0 to Pred(HeaderFieldList.Count) do begin
      if (Length(S + HeaderFieldList[i]) > MaxLine) then begin
        RawHeaders.Add(S);
        S := #09;
      end;
      S := S + HeaderFieldList[i];
      if (i < HeaderFieldList.Count - 1) and (S <> '') then begin
        S := S + Delim;                                                {!!.14}
        if Fold then begin
          RawHeaders.Add(S);
          S := #09;
        end;
      end;
    end;
    RawHeaders.Add(S);
  end;
end;

{ Add multiple instance header to raw headers }
procedure EncodeMultiHeader(const HeaderName : string;
                            RawHeaders, HeaderFieldList : TStringList;
                            Delim : AnsiChar;
                            Fold : Boolean);
var
  i, j : Integer;
  SL : TStringList;
  S : string;
begin
  if (HeaderFieldList.Count > 0) then
    for j := 1 to HeaderFieldList.Count do begin
      if not Fold then
        RawHeaders.Add(HeaderName + HeaderFieldList[j-1])
      else begin
        SL := TStringList.Create;
        try
          Parse(HeaderFieldList[j-1], Delim, SL);
          S := HeaderName;
          for i := 1 to SL.Count do begin
            S := S + SL[i-1];
            if (i < SL.Count) and (S <> '') then begin
{Begin !!.13}
              RawHeaders.Add(S);
              S := Delim;
{End !!.13}
            end;
          end;
        finally
          SL.Free;
        end;
        RawHeaders.Add(S);
      end;
    end;
end;

{ Generate "unique" boundary string }
function GenerateBoundary : string;
var
  Temp : TDateTime;
begin
  Temp := Now;
  Randomize;
  Result := '_NextPart_' + IntToHex(Trunc(Temp), 8) + '-' +
    IntToHex(Trunc(Frac(Temp) * 10000), 8) + '-' +
    IntToHex(GetTickCount64, 8) + '-' + IntToHex(Random($FFFF), 4);
end;

{ 16-bit CRC of stream between starting and ending offset }
function BinHexCRC(Stream : TStream; StartOffset, EndOffset : Longint) : Word;
var
  Crc : Word;
  InByte : Byte;
  ByteStream : TIpByteStream;

  procedure DoCRC(b : Byte);
    {- carry CRC division on with next byte }
  var
    j : Byte;
    t : Boolean;
  begin
    for j := 1 to 8 do begin
      t := (Crc and $8000) <> 0;
      Crc := (Crc shl 1) xor (b shr 7);
      if t then
        Crc := Crc xor $1021;
      b := b shl 1;
    end;
  end;

begin
  if (StartOffset > Stream.Size) or (EndOffset > Stream.Size) then
    raise EIpBaseException.Create(SBadOffset);

  Crc := 0;
  Stream.Position := StartOffset;
  ByteStream := TIpByteStream.Create(Stream);
  try
    while (ByteStream.Position < EndOffset) do begin
      if ByteStream.Read(InByte) then
        DoCrc(InByte);
    end;
  finally
    ByteStream.Free;
  end;
  DoCrc(0);
  DoCrc(0);
  Result := Swap(Crc);
end;

{ Reverse bytes and words }
function htonl(HostLong : Longint) : Longint;
var
  dw : Longint;
  wa : array[0..1] of Word absolute dw;
  w  : Word;
begin
  dw := HostLong;
  w := wa[0];
  wa[0] := Swap(wa[1]);
  wa[1] := Swap(w);
  Result := dw;
end;

{Begin !!.12}
{ TIpHeaderItem ****************************************************** }

constructor TIpHeaderItem.Create (Collection : TCollection);
begin
  inherited Create (Collection);
  FCollection := TIpHeaderCollection.Create (
                     TIpHeaderCollection(Collection).FOwner);

  FValue := TStringList.Create;
  FName  := '';
  FProperty := False;                                                  {!!.13}
end;                                                                     

destructor TIpHeaderItem.Destroy;                                        
begin                                                                    
  FCollection.Free;                                                      
  FCollection := nil;                                                    

  FValue.Free;                                                           
  FValue := nil;                                                         

  inherited Destroy;                                                     
end;                                                                     

procedure TIpHeaderItem.SetName(const Name : string);
begin
  FName := Name;
  FNameL := LowerCase(Name);
end;

procedure TIpHeaderItem.SetValue (v : TStringList);                      
begin                                                                    
  FValue.Assign (v);                                                     
end;                                                                     

{ TIpHeaderCollection ************************************************ } 

constructor TIpHeaderCollection.Create(AOwner : TPersistent);            
begin                                                                    
  inherited Create (TIpHeaderItem);                                      
  FOwner := AOwner;                                                      
end;                                                                     

{$IFNDEF VERSION5}                                                       
procedure TIpHeaderCollection.Delete(Item: integer);                     
begin                                                                    
  GetItem(Item).Free;                                                    
end;                                                                     
{$ENDIF}                                                                 

function TIpHeaderCollection.GetItem (Index : Integer) : TIpHeaderItem;  
begin                                                                    
  Result := TIpHeaderItem (inherited GetItem (Index));                   
end;                                                                     

function TIpHeaderCollection.GetOwner : TPersistent;                     
begin                                                                    
  Result := FOwner;                                                      
end;                                                                     

function TIpHeaderCollection.HasHeader (AName : string) : Integer;
var                                                                      
  i : Integer;                                                           
begin                                                                    
  Result := -1;                                                          
  AName := LowerCase(AName);
  for i := 0 to Count - 1 do
    if Items[i].NameL = AName then begin                      
      Result := i;                                                       
      Break;                                                             
    end;                                                                 
end;                                                                     

procedure TIpHeaderCollection.HeaderByName (AName   : string;            
                                            Headers : TStringList);      
var
  HeaderPos : Integer;                                                   
begin                                                                    
  Headers.Clear;                                                         
  HeaderPos := HasHeader (AName);                                        
  if HeaderPos >= 0 then                                                 
    Headers.Assign (Items[HeaderPos].Value);                             
end;                                                                     

procedure TIpHeaderCollection.LoadHeaders (AHeaderList : TStringList;
                                           Append      : Boolean);
var
  CurPos : Integer;

  function ExtractHeaderName (const AName : string) : string;
  {!!.15 - replaced local variable i with inx in order to avoid confusion with
    variable i in parent routine. }
  var
    inx     : Integer;
    NameLen : Integer;
  begin
    Result := '';
    CurPos := 0;

    inx := 0;
    NameLen := Length (AName);
    while (inx < NameLen) and (AName[inx + 1] <> ':') and
          (AName[inx + 1] >= #33) and (AName[inx + 1] <= #126) do
      Inc (inx);
    if (inx > 0) then
      Result := Copy (AName, 1, inx);
    CurPos := inx + 2;
  end;

  function IsWrappedLine (AHeaderList : TStringList;
                          LineToCheck : Integer) : Boolean;
  begin
    if LineToCheck < AHeaderList.Count then begin
      if Length (AHeaderList[LineToCheck]) > 0 then begin
        if (AHeaderList[LineToCheck][1] = ' ') or
           (AHeaderList[LineToCheck][1] = #09) then
          Result := True
        else
          Result := False;
      end else
        Result := False;
    end else
      Result := False;
  end;

  procedure GetFieldValue (    AHeaderList : TStringList;
                           var CurLine     : Integer;
                           var NewField    : TIpHeaderItem);
  var
    WorkLine : string;
    LineLen  : Integer;

  begin
    if CurLine >= AHeaderList.Count then
      Exit;
    LineLen  := Length (AHeaderList[CurLine]);
    while (CurPos < LineLen) and
          ((AHeaderList[CurLine][CurPos] = ' ') or
           (AHeaderList[CurLine][CurPos] = #09)) do
      Inc (CurPos);
    WorkLine := Copy (AHeaderList[CurLine],
                      CurPos, LineLen - CurPos + 1);
{Begin !!.13}
    Inc(CurLine);

    while IsWrappedLine (AHeaderList, CurLine) do begin
      WorkLine := WorkLine + #9 + Trim(AHeaderList[CurLine]);
      Inc(CurLine);
    end;
    NewField.Value.Add (Trim (WorkLine));
{End !!.13}
  end;

var                                                                      
  i          : Integer;                                                  
  HeaderName : string;                                                   
  NewHeader  : TIpHeaderItem;                                            
begin                                                                    
  if not Append then                                                     
    Clear;

  i := 0;                                                                
  while i < AHeaderList.Count do begin                                   
    HeaderName := ExtractHeaderName (AHeaderList[i]);                    
    if HeaderName <> '' then begin                                       
      NewHeader := TIpHeaderItem (Add);                                  
      NewHeader.Name := HeaderName;                                      
      GetFieldValue (AHeaderList, i, NewHeader);
{Begin !!.15}
    end
    else
      Inc(i);
{End !!.15}
  end;
end;                                                                     

procedure TIpHeaderCollection.SetItem (Index : Integer;                  
                                       Value : TIpHeaderItem);           
begin                                                                    
  inherited SetItem (Index, Value);                                      
end;
{End !!.12}

{ TIpMimeParts }
constructor TIpMimeParts.Create;
begin
  inherited Create;
  Entitys := TList.Create;
end;

destructor TIpMimeParts.Destroy;
begin
  Clear;
  Entitys.Free;
  inherited Destroy;
end;

{ Add Mime block to list }
function TIpMimeParts.Add(aEntity : TIpMimeEntity) : Integer;
begin
  Result := Entitys.Add(aEntity);
end;

{ Clear list }
procedure TIpMimeParts.Clear;
var
  i : Integer;
begin
  for i := Pred(Entitys.Count) downto 0 do
    Delete(i);
end;

{ Delete block from list }
procedure TIpMimeParts.Delete(aIndex : Integer);
begin
  if (aIndex >= 0) and (aIndex < Entitys.Count) then begin
    TIpMimeEntity(Entitys[aIndex]).Free;
  end;
end;

{ Remove block from list }
function TIpMimeParts.Remove(aEntity : TIpMimeEntity) : Integer;
begin
  Result := Entitys.Remove(Pointer(aEntity));
end;

{ Count property read access method }
function TIpMimeParts.GetCount : Integer;
begin
  Result := Entitys.Count;
end;

{ Parts property read access method }
function TIpMimeParts.GetPart(aIndex : Integer) : TIpMimeEntity;
begin
  if (aIndex >= 0) and (aIndex < Entitys.Count) then
    Result := TIpMimeEntity(Entitys[aIndex])
  else
    Result := nil;
end;

{ Returns list index of specified Mime block }
function TIpMimeParts.IndexOf(aEntity : TIpMimeEntity) : Integer;
begin
  Result := Entitys.IndexOf(aEntity);
end;


{ TIpMimeEntity }
constructor TIpMimeEntity.Create(ParentEntity : TIpMimeEntity);
begin
  inherited Create;
  FBody := TIpAnsiTextStream.CreateEmpty;
  FBody.Stream := TMemoryStream.Create;
  FMimeParts := TIpMimeParts.Create;
  FParent := ParentEntity;
  if (FParent <> nil) then
    FParentBoundary := FParent.Boundary;
end;

destructor TIpMimeEntity.Destroy;
begin
  FMimeParts.Free;
  FBody.FreeStream;
  FBody.Free;
  if (FParent <> nil) then
    FParent.MimeParts.Remove(Self);
  inherited Destroy;
end;

{ Clear Body property }
procedure TIpMimeEntity.ClearBody;
begin
  FBody.FreeStream;
  FBody.Stream := TMemoryStream.Create;
end;

{Begin !!.12}
{ Clear Body property in preparation for large attachment }
procedure TIpMimeEntity.ClearBodyLargeAttach(const AttachmentSize : Longint);
var
  FileName : string;
  Strm : TIpMemMapStream;
begin
  FBody.FreeStream;
  FileName := GetTemporaryFile(GetTemporaryPath);
  if FileExistsUTF8(FileName) then
    DeleteFileUTF8(FileName);
  Strm := TIpMemMapStream.Create(FileName, False, True);
  Strm.Size := Trunc(AttachmentSize * 1.3695);
  Strm.Open;
  FBody.Stream := Strm;
end;
{End !!.12}

{ Clear all properties }
procedure TIpMimeEntity.Clear;
begin
  ClearBody;
  FMimeParts.Clear;
  FBoundary := '';
  FCharacterSet := '';
  FContentDescription := '';
  FContentDispositionType := '';
  FContentID := '';
  FContentSubtype := '';
  FContentType := '';
  FContentTransferEncoding := emUnknown;
  FFileName := '';
  FIsMime := False;
  FIsMultipart := False;
  FMimeVersion := '';
  FEntityName := '';
  FRelatedType := '';                                                {!!.02}
  FRelatedSubtype := '';                                             {!!.02}
  FRelatedStart := '';                                               {!!.02}
  FRelatedStartInfo := '';                                           {!!.02}
end;

{ Build Mime (and nested Mime) block(s) from incoming text stream }
function TIpMimeEntity.DecodeEntity(InStream : TIpAnsiTextStream) : string;
var
  Blk : TIpMimeEntity;
  RawHeaders : TStringList;
  Decoded : Boolean;                                                   {!!.12}
  i,                                                                   {!!.13}
  LeadingBlankLines : Integer;                                         {!!.13}
begin
  Decoded := False;                                                    {!!.12}
  LeadingBlankLines := 0;                                              {!!.13}
  { skip blank lines in front of mime headers or body }
  Result := InStream.ReadLine;
  while (Result = '') and not InStream.AtEndOfStream do begin
    inc(LeadingBlankLines);
    Result := InStream.ReadLine;
  end;

  { decode mime headers if any }
{Begin !!.15}
  if (StrLIComp(PChar(strContent), PChar(Result), Length(strContent)) = 0) or
     (StrLIComp(PChar(strMimeVersion), PChar(Result),
                Length(strMimeVersion)) = 0) then begin
{End !!.15}
    RawHeaders := TStringList.Create;
    try
      repeat
        RawHeaders.Add(Result);
        Result := InStream.ReadLine;
      until (Result = '') or (InStream.AtEndOfStream);
      DecodeMimeHeaders(RawHeaders);
    finally
      RawHeaders.Free;
    end;
    Result := InStream.ReadLine;
    { skip blank lines between mime headers and mime body }
    while (Result = '') and not InStream.AtEndOfStream do
      Result := InStream.ReadLine;
  end;

  { decode body - main loop }
{Begin !!.15}
  if (FParentBoundary <> '') and
     (Result = '--' + FParentBoundary) then
    { The body of this entity is empty & we are now positioned at the boundary
      marker for the next entity. }
    Decoded := True
  else
{End !!.15}
  while not (((FParentBoundary <> '') and                              {!!.12}
              (Result = '--' + FParentBoundary)                        {!!.12}
             ) or InStream.AtEndOfStream) do begin…