PageRenderTime 45ms CodeModel.GetById 23ms app.highlight 9ms RepoModel.GetById 1ms app.codeStats 2ms

/components/turbopower_ipro/ipmsg.pas

http://github.com/graemeg/lazarus
Pascal | 3913 lines | 3167 code | 357 blank | 389 comment | 307 complexity | 49ed960178c43d853e819ba5dc768291 MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1{******************************************************************}
   2{*               IPMSG.PAS - MIME message classes                 *}
   3{******************************************************************}
   4
   5{ $Id$ }
   6
   7(* ***** BEGIN LICENSE BLOCK *****
   8 * Version: MPL 1.1
   9 *
  10 * The contents of this file are subject to the Mozilla Public License Version
  11 * 1.1 (the "License"); you may not use this file except in compliance with
  12 * the License. You may obtain a copy of the License at
  13 * http://www.mozilla.org/MPL/
  14 *
  15 * Software distributed under the License is distributed on an "AS IS" basis,
  16 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  17 * for the specific language governing rights and limitations under the
  18 * License.
  19 *
  20 * The Original Code is TurboPower Internet Professional
  21 *
  22 * The Initial Developer of the Original Code is
  23 * TurboPower Software
  24 *
  25 * Portions created by the Initial Developer are Copyright (C) 2000-2002
  26 * the Initial Developer. All Rights Reserved.
  27 *
  28 * Contributor(s):
  29 *
  30 * Markus Kaemmerer <mk@happyarts.de> SourceForge: mkaemmerer
  31 *
  32 * ***** END LICENSE BLOCK ***** *)
  33
  34{ Global defines potentially affecting this unit }
  35
  36{$I IPDEFINE.INC}
  37
  38unit IpMsg;
  39
  40interface
  41
  42uses
  43  {$IFDEF IP_LAZARUS}
  44  LCLType,
  45  LCLIntf,
  46  LazFileUtils, LazUTF8Classes,
  47  {$ELSE}
  48  Windows,
  49  {$ENDIF}
  50  Classes,
  51  SysUtils,
  52  IpStrms,
  53  {$IFNDEF IP_LAZARUS}
  54  //IpSock, //JMN
  55  {$ENDIF}
  56  IpUtils,
  57  IpConst;
  58
  59type
  60  TIpMimeEncodingMethod = (em7Bit, em8Bit, emBase64, emBinary, emBinHex,
  61                           emQuoted, emUUEncode, emUnknown);
  62
  63
  64{ TIpMimeEntity }
  65type
  66  TIpCodingProgressEvent = procedure(Sender : TObject; Progress : Byte;
  67                                     var Abort : Boolean) of object;
  68
  69{Begin !!.12}
  70type
  71  TIpHeaderTypes = (htBCC, htCC, htControl, htDate, htDispositionNotify,
  72                    htFollowUp, htFrom, htInReplyTo, htKeywords,
  73                    htMessageID, htNewsgroups, htNNTPPostingHost,
  74                    htOrganization, htPath, htPostingHost, htReceived,
  75                    htReferences, htReplyTo, htReturnPath, htSender,
  76                    htSubject, htTo, htUserFields, htXIpro);
  77
  78  TIpHeaderInfo = record
  79    FieldType   : TIpHeaderTypes;
  80    FieldString : string;
  81  end;
  82
  83const
  84  IpMaxHeaders = 24;
  85
  86  IpHeaderXRef : array [0..IpMaxHeaders - 1] of  TIpHeaderInfo =
  87    ((FieldType : htBCC;               FieldString : 'BCC'),
  88     (FieldType : htCC;                FieldString : 'CC'),
  89     (FieldType : htControl;           FieldString : 'Control: '),
  90     (FieldType : htDate;              FieldString : 'Date'),
  91     (FieldType : htDispositionNotify; FieldString : 'Disposition-Notification-To'),
  92     (FieldType : htFollowUp;          FieldString : 'Followup-To: '),
  93     (FieldType : htFrom;              FieldString : 'From'),
  94     (FieldType : htInReplyTo;         FieldString : 'In-Reply-To'),
  95     (FieldType : htKeywords;          FieldString : 'Keywords'),
  96     (FieldType : htMessageID;         FieldString : 'Message-ID'),
  97     (FieldType : htNewsgroups;        FieldString : 'Newsgroups'),
  98     (FieldType : htNNTPPostingHost;   FieldString : 'NNTP-Posting-Host'),
  99     (FieldType : htOrganization;      FieldString : 'Organization'),
 100     (FieldType : htPath;              FieldString : 'Path'),
 101     (FieldType : htPostingHost;       FieldString : 'Posting-Host'),
 102     (FieldType : htReceived;          FieldString : 'Received'),
 103     (FieldType : htReferences;        FieldString : 'References'),
 104     (FieldType : htReplyTo;           FieldString : 'Reply-To'),
 105     (FieldType : htReturnPath;        FieldString : 'Return-Path'),
 106     (FieldType : htSender;            FieldString : 'Sender'),
 107     (FieldType : htSubject;           FieldString : 'Subject'),
 108     (FieldType : htTo;                FieldString : 'To'),
 109     (FieldType : htUserFields;        FieldString : 'X-'),
 110     (FieldType : htXIpro;             FieldString : 'X-Ipro'));
 111
 112type
 113  TIpHeaderCollection = class;
 114
 115  TIpHeaderItem = class (TCollectionItem)
 116    private
 117      FCollection  : TIpHeaderCollection;
 118      FName        : string;
 119      FNameL       : string;
 120        { Lower case version of FName. Used to speed up header searches. }
 121      FProperty    : Boolean;                                          {!!.13}
 122      FValue       : TStringList;
 123    protected
 124      procedure SetName(const Name : string);
 125      procedure SetValue (v : TStringList);
 126    public
 127      constructor Create (Collection : TCollection); override;
 128      destructor Destroy; override;
 129    published
 130      property Collection : TIpHeaderCollection
 131               read FCollection write FCollection;
 132      property Name : string read FName write SetName;
 133      property NameL : string read FNameL;
 134        { Lower case version of Name property. }
 135      property IsProperty : Boolean read FProperty write FProperty;    {!!.13}
 136        { Set to True if this header is exposed via an iPRO property. }{!!.13}
 137      property Value : TStringList read FValue write SetValue;
 138  end;
 139
 140  TIpHeaderCollection = class (TCollection)
 141    private
 142      FOwner : TPersistent;                                              
 143
 144    protected                                                            
 145      function GetItem (Index : Integer) : TIpHeaderItem;
 146      function GetOwner : TPersistent; override;                         
 147      procedure SetItem (Index : Integer; Value : TIpHeaderItem);        
 148
 149    public                                                               
 150      constructor Create (AOwner : TPersistent);                         
 151
 152      {$IFNDEF VERSION5}                                                 
 153      procedure Delete (Item : integer);                                 
 154      {$ENDIF}
 155      function HasHeader (AName : string) : Integer;
 156      procedure HeaderByName (AName   : string;
 157                              Headers : TStringList);
 158      procedure LoadHeaders (AHeaderList : TStringList;                  
 159                             Append      : Boolean);                     
 160
 161      property Items[Index : Integer] : TIpHeaderItem                    
 162               read GetItem write SetItem;                               
 163  end;                                                                   
 164{End !!.12}
 165
 166  TIpMimeParts = class; { Forwards }
 167
 168  TIpMimeEntity = class(TPersistent)
 169  protected {private}
 170    FProgress                : Byte;
 171    PrevProgress             : Byte;
 172    FMimeParts               : TIpMimeParts;
 173    FParentBoundary          : string;
 174    FBody                    : TIpAnsiTextStream;
 175    FEntityName              : string;
 176    FBoundary                : string;
 177    FCharacterSet            : string;
 178    FContentDescription      : string;
 179    FContentDispositionType  : string;
 180    FContentID               : string;
 181    FContentSubtype          : string;
 182    FContentType             : string;
 183    FCreationDate            : string;
 184    FContentTransferEncoding : TIpMimeEncodingMethod;
 185    FFileName                : string;
 186    FIsMime                  : Boolean;
 187    FIsMultipart             : Boolean;
 188    FModificationDate        : string;
 189    FMimeVersion             : string;
 190    FOnCodingProgress        : TIpCodingProgressEvent;
 191    FOriginalSize            : Longint;
 192    FParent                  : TIpMimeEntity;
 193    FReadDate                : string;
 194    FRelatedType             : string;                                 {!!.02}
 195    FRelatedSubtype          : string;                                 {!!.02}
 196    FRelatedStart            : string;                                 {!!.02}
 197    FRelatedStartInfo        : string;                                 {!!.02}
 198    FAttachmentCount         : Integer;                                {!!.12}
 199
 200  protected {methods}
 201    procedure Clear; virtual;
 202    procedure ClearBodyLargeAttach(const AttachmentSize : Longint); virtual;  {!!.12}
 203    function  ContainsSpecialChars(const Value : string) : Boolean;    {!!.14}
 204    procedure DecodeContentDisposition(const aDisp : string);
 205    procedure DecodeContentType(const aType : string);
 206    function  DecodeContentTransferEncoding(const aEncoding : string) :
 207                                            TIpMimeEncodingMethod;
 208    procedure DecodeMimeHeaders(RawHeaders : TStringlist);
 209    procedure DoOnCodingProgress(Count, TotalSize : Longint; var Abort : Boolean);
 210    procedure EncodeContentDisposition(RawHeaders : TStringList);
 211    procedure EncodeContentType(RawHeaders : TStringList);
 212    procedure EncodeContentTransferEncoding(RawHeaders : TStringList);
 213    procedure EncodeMimeHeaders(RawHeaders : TStringlist);
 214    procedure OctetStreamToHextetStream(InStream : TStream; OutStream : TIpAnsiTextStream;
 215                                        const Table; PadChar, Delim : AnsiChar);
 216    procedure Decode8Bit(OutStream : TStream);
 217    procedure DecodeBase64(OutStream : TStream);
 218    procedure DecodeBinHex(OutStream : TStream);
 219    procedure DecodeQuoted(OutStream : TStream);
 220    procedure DecodeUUEncode(OutStream : TStream);
 221    procedure Encode8Bit(InStream : TStream);
 222    procedure EncodeBase64(InStream : TStream);
 223    procedure EncodeBinHex(InStream : TStream; const aFileName : string);
 224    procedure EncodeQuoted(InStream : TStream);
 225    procedure EncodeUUEncode(InStream : TStream; const aFileName : string);
 226    function DecodeEntity(InStream : TIpAnsiTextStream) : string;
 227    function DecodeEntityAsAttachment(InStream : TIpAnsiTextStream) : string;  {!!.01}
 228    function EncodeEntity(OutStream : TIpAnsiTextStream) : string;
 229    procedure ReadBody(InStream : TIpAnsiTextStream; const StartLine : string); {!!.12}
 230
 231  protected {properties}
 232    property OnCodingProgress : TIpCodingProgressEvent
 233      read FOnCodingProgress write FOnCodingProgress;
 234
 235  public {methods}
 236    constructor Create(ParentEntity : TIpMimeEntity); virtual;
 237    destructor  Destroy; override;
 238    procedure ClearBody;
 239    procedure EncodeBodyFile(const InFile : string);
 240    procedure EncodeBodyStream(InStream : TStream; const aFileName : string);
 241    procedure EncodeBodyStrings(InStrings : TStrings; const aFileName : string);
 242    procedure ExtractBodyFile(const OutFile : string);
 243    procedure ExtractBodyStream(OutStream : TStream);
 244    procedure ExtractBodyStrings(OutStrings : TStrings);
 245    function FindNestedMimePart(const aType, aSubType, aContentID : string) : TIpMimeEntity; {!!.02}
 246    function  GetMimePart(const aType, aSubType, aContentID : string;
 247                              CanCreate : Boolean) : TIpMimeEntity;
 248    function  NewMimePart : TIpMimeEntity;
 249
 250    property AttachmentCount : Integer read FAttachmentCount;          {!!.12}
 251
 252  public {properties}
 253    property Body : TIpAnsiTextStream
 254      read FBody;
 255
 256    property Boundary : string
 257      read FBoundary write FBoundary;
 258
 259    property CharacterSet : string
 260      read FCharacterSet write FCharacterSet;
 261
 262    property ContentDescription : string
 263      read FContentDescription write FContentDescription;
 264
 265    property ContentDispositionType : string
 266      read FContentDispositionType write FContentDispositionType;
 267
 268    property ContentID : string
 269      read FContentID write FContentID;
 270
 271    property ContentSubtype : string
 272      read FContentSubtype write FContentSubtype;
 273
 274    property ContentTransferEncoding : TIpMimeEncodingMethod
 275      read FContentTransferEncoding write FContentTransferEncoding;
 276
 277    property ContentType : string
 278      read FContentType write FContentType;
 279
 280    property CreationDate : string
 281      read FCreationDate write FCreationDate;
 282
 283    property EntityName : string
 284      read FEntityName write FEntityName;
 285
 286    property FileName : string
 287      read FFileName write FFileName;
 288
 289    property IsMime : Boolean
 290      read FIsMime;
 291
 292    property IsMultipart : Boolean
 293      read FIsMultipart;
 294
 295    property MimeParts : TIpMimeParts
 296      read FMimeParts;
 297
 298    property MimeVersion : string
 299      read FMimeVersion write FMimeVersion;
 300
 301    property ModificationDate : string
 302      read FModificationDate write FModificationDate;
 303
 304    property OriginalSize : Longint
 305      read FOriginalSize write FOriginalSize;
 306
 307    property Parent : TIpMimeEntity
 308      read FParent;
 309
 310    property ReadDate : string
 311      read FReadDate write FReadDate;
 312
 313    property RelatedStart : string                                   {!!.02}
 314      read FRelatedStart write FRelatedStart;
 315
 316    property RelatedStartInfo : string                               {!!.02}
 317      read FRelatedStartInfo write FRelatedStartInfo;
 318
 319    property RelatedSubtype : string                                 {!!.02}
 320      read FRelatedSubtype write FRelatedSubtype;
 321
 322    property RelatedType : string                                    {!!.02}
 323      read FRelatedType write FRelatedType;
 324
 325  end;
 326
 327
 328{ TIpMimeParts }
 329  TIpMimeParts = class
 330  protected {private}
 331    Entitys : TList;
 332    function GetCount : Integer;
 333    function GetPart(aIndex : Integer) : TIpMimeEntity;
 334  public {methods}
 335    constructor Create;
 336    destructor  Destroy; override;
 337    function Add(aEntity : TIpMimeEntity) : Integer;
 338    function Remove(aEntity : TIpMimeEntity) : Integer;
 339    procedure Clear;
 340    procedure Delete(aIndex : Integer);
 341    function IndexOf(aEntity : TIpMimeEntity) : Integer;
 342  public {properties}
 343    property Count : Integer
 344      read GetCount;
 345    property Parts[aIndex : Integer] : TIpMimeEntity
 346      read GetPart; default;
 347  end;
 348
 349
 350{ TIpMessage }
 351type
 352  TIpMessage = class(TIpMimeEntity)
 353  protected {private}
 354    MsgStream : TIpAnsiTextStream;
 355
 356  protected {property variables}
 357    FBCC             : TStringList;
 358    FCC              : TStringList;
 359    FDate            : string;
 360    FFrom            : string;
 361    FInReplyTo       : string;
 362    FKeywords        : string;
 363    FFollowupTo      : string;                                           {!!.12}
 364    FControl         : string;                                           {!!.12}
 365    FMessageID       : string;
 366    FMessageTag      : Integer;
 367    FNewsgroups      : TStringList;
 368    FNNTPPostingHost : string;
 369    FOrganization    : string;
 370    FPath            : TStringList;
 371    FPostingHost     : string;
 372    FReceived        : TStringList;
 373    FRecipients      : TStringList;
 374    FReferences      : TStringList;
 375    FReplyTo         : string;
 376    FReturnPath      : string;
 377    FSender          : string;
 378    FSubject         : string;
 379    FUserFields      : TStringList;
 380    FHeaders         : TIpHeaderCollection;                              {!!.12}
 381    FDispositionNotify: string;
 382
 383  protected {methods}
 384    procedure CheckAllHeaders;                                           {!!.12}
 385    procedure CheckHeaderType (HeaderInfo : TIpHeaderItem;               {!!.12}
 386                               HeaderType : TIpHeaderTypes);             {!!.12}
 387    procedure Clear; override;
 388    procedure NewMessageStream;
 389    function  GetPosition : Longint;
 390    function  GetSize : Longint;
 391    procedure SetPosition(Value : Longint);
 392    procedure SetBCC(const Value: TStringList);
 393    procedure SetCC(const Value: TStringList);
 394    procedure SetNewsgroups(const Value: TStringList);
 395    procedure SetPath(const Value: TStringList);
 396    procedure SetReceived(const Value: TStringList);
 397    procedure SetRecipients(const Value: TStringList);
 398    procedure SetReferences(const Value: TStringlist);
 399    procedure SetUserFields(const Value: TStringList);
 400
 401  public {methods}
 402    constructor CreateMessage; virtual;
 403    destructor  Destroy; override;
 404
 405    procedure AddDefaultAttachment(const aFileName : string);          {!!.02}
 406    procedure AddDefaultAttachmentAs (const aFileName      : string;   {!!.12}
 407                                      const AttachmentName : string);  {!!.12}
 408    procedure Assign(Source : TPersistent); override;
 409    function  AtEndOfStream : Boolean;
 410    procedure DecodeMessage; virtual;
 411    procedure EncodeMessage; virtual;
 412    function  GetBodyHtml(CanCreate : Boolean) : TIpMimeEntity;
 413    function  GetBodyPlain(CanCreate : Boolean) : TIpMimeEntity;
 414    procedure LoadFromFile(const aFileName : string);
 415    procedure LoadFromStream(aStream : TStream);                       {!!.12}
 416    procedure NewMessage;
 417    function  ReadLine : string;
 418    function  ReadLineCRLF : string;
 419    procedure SaveToFile(const aFileName : string);
 420    procedure SaveToStream(Stream: TStream);                           {!!.12}
 421    procedure SetHeaders(Headers : TIpHeaderCollection);               {!!.12}
 422    procedure WriteLine(const aSt : string);
 423
 424  public {properties}
 425    property BCC : TStringList
 426      read FBCC write SetBCC;                                          {!!.01}
 427
 428    property CC : TStringList
 429      read FCC write SetCC;                                            {!!.01}
 430
 431    property Control : string                                          {!!.12}
 432      read FControl write FControl;                                    {!!.12}
 433
 434    property Date : string
 435      read FDate write FDate;
 436
 437    property DispositionNotification : string                          {!!.12}
 438      read FDispositionNotify write FDispositionNotify;                {!!.12}
 439
 440    property FollowupTo : String                                       {!!.12}
 441      read FFollowupTo Write FFollowupTo;                              {!!.12}
 442
 443    property From : string
 444      read FFrom write FFrom;
 445
 446    property Headers : TIpHeaderCollection                             {!!.12}
 447             read FHeaders write SetHeaders;                           {!!.12}
 448
 449    property InReplyTo : string
 450      read FInReplyTo write FInReplyTo;
 451
 452    property Keywords : string
 453      read FKeywords write FKeywords;
 454
 455    property MessageID : string
 456      read FMessageID write FMessageID;
 457
 458    property MessageStream : TIpAnsiTextStream                         {!!.03}
 459      read MsgStream;                                                  {!!.03}
 460
 461    property MessageTag : Integer
 462      read FMessageTag write FMessageTag;
 463
 464    property Newsgroups : TStringList
 465      read FNewsgroups write SetNewsgroups;                            {!!.01}
 466
 467    property NNTPPostingHost : string
 468      read FNNTPPostingHost write FNNTPPostingHost;
 469
 470    property Organization : string
 471      read FOrganization write FOrganization;
 472
 473    property Path : TStringList
 474      read FPath write SetPath;                                        {!!.01}
 475
 476    property Position : Longint
 477      read GetPosition write SetPosition;
 478
 479    property PostingHost : string
 480      read FPostingHost write FPostingHost;
 481
 482    property Received : TStringList
 483      read FReceived write SetReceived;                                {!!.01}
 484
 485    property Recipients : TStringList
 486      read FRecipients write SetRecipients;                            {!!.01}
 487
 488    property References : TStringlist
 489      read FReferences write SetReferences;                            {!!.01}
 490
 491    property ReplyTo : string
 492      read FReplyTo write FReplyTo;
 493
 494    property ReturnPath : string
 495      read FReturnPath write FReturnPath;
 496
 497    property Sender : string
 498      read FSender write FSender;
 499
 500    property Size : Longint
 501      read GetSize;
 502
 503    property Subject : string
 504      read FSubject write FSubject;
 505
 506    property UserFields : TStringList
 507      read FUserFields write SetUserFields;                            {!!.01}
 508
 509  end;
 510
 511
 512{ TIpMailMessage}
 513type
 514  TIpMailMessage = class(TIpMessage)
 515  published {properties}
 516    property BCC;
 517    property CC;
 518    property ContentDescription;
 519    property ContentTransferEncoding;
 520    property ContentType;
 521    property Date;
 522    property From;
 523    property Keywords;
 524    property MailTo : TStringList
 525      read FRecipients write SetRecipients;                            {!!.01}
 526    property OnCodingProgress;
 527    property References;
 528    property ReplyTo;
 529    property Sender;
 530    property Subject;
 531    property UserFields;
 532end;
 533
 534
 535{ TIpNewsArticle }
 536type
 537  TIpNewsArticle = class(TIpMessage)
 538  published {properties}
 539    property ContentDescription;
 540    property ContentTransferEncoding;
 541    property ContentType;
 542    property Date;
 543    property From;
 544    property Keywords;
 545    property Newsgroups;
 546    property NNTPPostingHost;
 547    property OnCodingProgress;
 548    property Path;
 549    property References;
 550    property ReplyTo;
 551    property Sender;
 552    property Subject;
 553    property UserFields;
 554end;
 555
 556
 557{ TIpFormDataEntity }
 558type
 559  TIpFormDataEntity = class(TIpMimeEntity)
 560  protected
 561    FFilesEntity : TIpMimeEntity;
 562  public {methods}
 563    constructor Create(ParentEntity : TIpMimeEntity); override;
 564    destructor  Destroy; override;
 565    procedure AddFormData(const aName, aText : string);
 566    procedure AddFile(const aFileName, aContentType, aSubtype : string;
 567                      aEncoding : TIpMimeEncodingMethod);
 568    procedure SaveToStream(aStream : TStream);
 569  end;
 570
 571 {$IFNDEF IP_LAZARUS}
 572 { dummy class so this unit will be added to the uses clause when an }
 573 { IpPop3Client, IpSmtpClient or IpNntpClient component is dropped on the form }
 574 (*** //JMN
 575 TIpCustomEmailClass = class(TIpCustomClient)
 576 end;
 577 **)
 578 {$ENDIF}
 579
 580function IpBase64EncodeString(const InStr: string): string;       {!!.02}{!!.03}
 581
 582{Begin !!.12}
 583const
 584  IpLgAttachSizeBoundry = 5 * 1024 * 1024;
 585    { Attachments over this size will be encoded using a TIpMemMapStream for
 586      greatly improved performance. This boundary also applies to the final
 587      encoding of messages with large attachments. }
 588
 589implementation
 590
 591const
 592  { standard headers }
 593  strBCC               = 'BCC: ';
 594  strCC                = 'CC: ';
 595  strDate              = 'Date: ';
 596  strDispositionNotify = 'Disposition-Notification-To: ';
 597  strFrom              = 'From: ';
 598  strInReplyTo         = 'In-Reply-To: ';
 599  strKeywords          = 'Keywords: ';
 600  strMessageID         = 'Message-ID: ';
 601  strNewsgroups        = 'Newsgroups: ';
 602  strNNTPPostingHost   = 'NNTP-Posting-Host: ';
 603  strOrganization      = 'Organization: ';
 604  strPath              = 'Path: ';
 605  strPostingHost       = 'Posting-Host: ';
 606  strReceived          = 'Received: ';
 607  strReferences        = 'References: ';
 608  strReplyTo           = 'Reply-To: ';
 609  strReturnPath        = 'Return-Path: ';
 610  strSender            = 'Sender: ';
 611  strSubject           = 'Subject: ';
 612  strTo                = 'To: ';
 613  strUserFields        = 'X-';
 614  strXIpro             = 'X-Ipro: ';
 615  strFollowUp          = 'Followup-To: ';                               {!!.12}
 616  strControl           = 'Control: ';                                   {!!.12}
 617
 618{Begin !!.13}
 619  IpMimeHeaders : array [0..5] of string =
 620    { List of MIME headers that must be marked as public properties in
 621      the message's Headers collection. Marking them as a public property
 622      prevents them from being written out twice if the message is saved
 623      to a file or stream. }
 624    (
 625      'Content-Type',
 626      'MIME-Version',
 627      'Content-Transfer-Encoding',
 628      'Content-Description',
 629      'Content-ID',
 630      'Content-Disposition'
 631    );
 632{End !!.13}
 633
 634  { MIME headers }
 635  strMimeVersion             = 'MIME-Version: ';
 636  strContent                 = 'Content-';
 637  strContentBase             = strContent + 'Base: ';
 638  strContentDescription      = strContent + 'Description: ';
 639  strContentDisposition      = strContent + 'Disposition: ';
 640  strContentID               = strContent + 'ID: ';
 641  strContentLanguage         = strContent + 'Language: ';
 642  strContentLocation         = strContent + 'Location: ';
 643  strContentTransferEncoding = strContent + 'Transfer-Encoding: ';
 644  strContentType             = strContent + 'Type: ';
 645
 646  { MIME content types }
 647  strApplication = 'application';
 648  strAudio       = 'audio';
 649  strFiles       = 'files';
 650  strFormData    = 'form-data';
 651  strImage       = 'image';
 652  strMessage     = 'message';
 653  strMultiPart   = 'multipart';
 654  strText        = 'text';
 655  strVideo       = 'video';
 656
 657  { MIME content subtypes and parameters }
 658  strBoundary    = 'boundary=';
 659  strCharSet     = 'charset=';
 660  strMixed       = 'mixed';
 661  strName        = 'name=';
 662  strPlain       = 'plain';
 663  strHTML        = 'html';
 664  strOctetStream = 'octet-stream';
 665  strAlternative = 'alternative';
 666  strRelated     = 'related';                                        {!!.02}
 667
 668  { MIME content disposition parameters }
 669  strAttachment       = 'attachment';
 670  strInline           = 'inline';
 671  strCreationDate     = 'creation-date=';
 672  strFilename         = 'filename=';
 673  strModificationDate = 'modification-date=';
 674  strReadDate         = 'read-date=';
 675  strStart            = 'start=';                                    {!!.02}
 676  strStartInfo        = 'start-info=';                               {!!.02}
 677  strSize             = 'size=';
 678  strType             = 'type=';                                     {!!.02}
 679
 680
 681  { MIME encoding methods }
 682  str7Bit     = '7bit';
 683  str8Bit     = '8bit';
 684  strBase64   = 'base64';
 685  strBinary   = 'binary';
 686  strBinHex   = 'binhex';
 687  strQuoted   = 'quoted-printable';
 688  strUUEncode = 'uuencoded';
 689
 690
 691  { default MIME content type information }
 692{$I IPDEFCT.INC}
 693
 694type
 695  TIp6BitTable = array[0..63] of AnsiChar;
 696
 697const {- BinHex encoding table }
 698  IpBinHexTable : TIp6BitTable = (
 699    '!', '"', '#', '$', '%', '&', '''', '(',
 700    ')', '*', '+', ',', '-', '0', '1',  '2',
 701    '3', '4', '5', '6', '8', '9', '@',  'A',
 702    'B', 'C', 'D', 'E', 'F', 'G', 'H',  'I',
 703    'J', 'K', 'L', 'M', 'N', 'P', 'Q',  'R',
 704    'S', 'T', 'U', 'V', 'X', 'Y', 'Z',  '[',
 705    '`', 'a', 'b', 'c', 'd', 'e', 'f',  'h',
 706    'i', 'j', 'k', 'l', 'm', 'p', 'q',  'r');
 707
 708const {-BinHex decoding table }
 709  IpHexBinTable : array[33..114] of Byte = (
 710    $00, $01, $02, $03, $04, $05, $06, $07,
 711    $08, $09, $0A, $0B, $0C, $FF, $FF, $0D,
 712    $0E, $0F, $10, $11, $12, $13, $FF, $14,
 713    $15, $FF, $FF, $FF, $FF, $FF, $FF, $16,
 714    $17, $18, $19, $1A, $1B, $1C, $1D, $1E,
 715    $1F, $20, $21, $22, $23, $24, $FF, $25,
 716    $26, $27, $28, $29, $2A, $2B, $FF, $2C,
 717    $2D, $2E, $2F, $FF, $FF, $FF, $FF, $30,
 718    $31, $32, $33, $34, $35, $36, $FF, $37,
 719    $38, $39, $3A, $3B, $3C, $FF, $FF, $3D,
 720    $3E, $3F);
 721
 722const { Base64 encoding table }
 723  Ip64Table : TIp6BitTable = (
 724    #065, #066, #067, #068, #069, #070, #071, #072,
 725    #073, #074, #075, #076, #077, #078, #079, #080,
 726    #081, #082, #083, #084, #085, #086, #087, #088,
 727    #089, #090, #097, #098, #099, #100, #101, #102,
 728    #103, #104, #105, #106, #107, #108, #109, #110,
 729    #111, #112, #113, #114, #115, #116, #117, #118,
 730    #119, #120, #121, #122, #048, #049, #050, #051,
 731    #052, #053, #054, #055, #056, #057, #043, #047);
 732
 733const { Base64 decoding table }
 734  IpD64Table : array[#43..#122] of Byte = (                          {!!.12}
 735    $3E, $7F, $7F, $7F, $3F, $34, $35, $36,
 736    $37, $38, $39, $3A, $3B, $3C, $3D, $7F,
 737    $7F, $7F, $7F, $7F, $7F, $7F, $00, $01,
 738    $02, $03, $04, $05, $06, $07, $08, $09,
 739    $0A, $0B, $0C, $0D, $0E, $0F, $10, $11,
 740    $12, $13, $14, $15, $16, $17, $18, $19,
 741    $7F, $7F, $7F, $7F, $7F, $7F, $1A, $1B,
 742    $1C, $1D, $1E, $1F, $20, $21, $22, $23,
 743    $24, $25, $26, $27, $28, $29, $2A, $2B,
 744    $2C, $2D, $2E, $2F, $30, $31, $32, $33);
 745
 746const { UUEncode encoding table }
 747  IpUUTable : TIp6BitTable = (
 748    #96, #33, #34, #35, #36, #37, #38, #39,
 749    #40, #41, #42, #43, #44, #45, #46, #47,
 750    #48, #49, #50, #51, #52, #53, #54, #55,
 751    #56, #57, #58, #59, #60, #61, #62, #63,
 752    #64, #65, #66, #67, #68, #69, #70, #71,
 753    #72, #73, #74, #75, #76, #77, #78, #79,
 754    #80, #81, #82, #83, #84, #85, #86, #87,
 755    #88, #89, #90, #91, #92, #93, #94, #95);
 756
 757const
 758  HexDigits : array[0..$F] of AnsiChar = '0123456789ABCDEF';
 759  RLEChar : Byte = $90;
 760  BinHexFileType : array[0..3] of Byte = ($49, $42, $4D, $3F);  { "IBM?" }
 761  CRLF = #13#10;
 762  MaxLine = 1000;                                                       {!!.12}
 763  MaxLineEncode = 77;                                                   {!!.13}
 764    { Maximum line length for QuotablePrintable & Base64 encoding. }    {!!.13}
 765
 766type
 767  BinHexHeader = packed record
 768    Version  : Byte;
 769    FileType : array[0..3] of Byte;
 770    Creator  : array[0..3] of Byte;
 771    Flags    : Word;
 772    DFLong   : Longint;
 773    RFLong   : Longint;
 774  end;
 775
 776function IsSameString (Str1          : string;                           {!!.12}
 777                       Str2          : string;                           {!!.12}
 778                       CaseSensitive : Boolean) : Boolean;               {!!.12}
 779begin                                                                    {!!.12}
 780  if CaseSensitive then                                                  {!!.12}
 781    Result := (Str1 = Str2)                                              {!!.12}
 782  else                                                                   {!!.12}
 783    Result := StrIComp (PChar (Str1), PChar (Str2)) = 0;                 {!!.12}
 784end;                                                                     {!!.12}
 785
 786{ Parse string into string list }
 787procedure Parse(const Line : string; Delim : AnsiChar; var List : TStringList);
 788var
 789  iPos, jPos : Integer;
 790  Term : string;
 791begin
 792  iPos := 1;
 793  jPos := IpUtils.CharPos(Delim, Line);
 794  while (jPos > 0) do begin
 795    Term := Copy(Line, iPos, jPos - iPos);                           {!!.02}
 796    if (Term <> '') then
 797      List.Add(Trim(Term));
 798    iPos := jPos + 1;
 799    jPos := IpUtils.CharPosIdx(Delim, Line, iPos);
 800  end;
 801  if (iPos < Length(Line)) then
 802     List.Add(Trim(Copy(Line, iPos, Length(Line))));
 803end;
 804
 805{ Return a particular parameter from a parsed header parameter list }
 806procedure DecodeSingleParameter(const ParamName : string;
 807                                RawParams : TStringList;
 808                                var ParamFieldStr : string);
 809var
 810  S : string;
 811  i, j : Integer;
 812begin
 813  ParamFieldStr := '';
 814  {find the line containing the parameter field name}
 815  for i := 1 to RawParams.Count do begin
 816    S := RawParams[i-1];
 817    if StrLIComp(PChar(ParamName), PChar(S), Length(ParamName)) = 0 then begin
 818      {strip off the parameter field name and remove quotes }
 819      ParamFieldStr := Copy(S, Length(ParamName) + 1, Length(S));
 820      j := IpUtils.CharPos('"', ParamFieldStr);
 821      while (j > 0) do begin
 822        Delete(ParamFieldStr, j, 1);
 823        j := IpUtils.CharPos('"', ParamFieldStr);
 824      end;
 825      Break;
 826    end;
 827  end;
 828end;
 829
 830{ Return a particular header as string }
 831procedure DecodeSingleHeader(const HeaderName : string;
 832                             RawHeaders : TStringList;
 833                             var HeaderFieldStr : string);
 834var
 835  S, S2 : string;
 836  i, j : Integer;
 837begin
 838  HeaderFieldStr := '';
 839  {find the line containing the header field name}
 840  for i := 1 to RawHeaders.Count do begin
 841    S := RawHeaders[i-1];
 842    if StrLIComp(PChar(HeaderName), PChar(S), Length(HeaderName)) = 0 then begin
 843      {strip off the header field name}
 844      S := Copy(S, Length(HeaderName) + 1, Length(S));
 845      {unfold the header if continued on more than one line}
 846      if (i < RawHeaders.Count) then
 847        for j := i to Pred(RawHeaders.Count) do begin
 848          S2 := RawHeaders[j];
 849          if (Length(S2) > 0) and (S2[1] <> #09) and (S2[1] <> ' ') then
 850            Break
 851          else
 852            S := S + S2;
 853        end;
 854      HeaderFieldStr := S;
 855      Break;
 856    end;
 857  end;
 858end;
 859
 860{ Return a particular header as string list }
 861(*procedure DecodeListHeader(const HeaderName : string;
 862                           RawHeaders, HeaderFieldList : TStringList);
 863var
 864  S : string;
 865  i, j : Integer;
 866begin
 867  {find the line containing the header field name}
 868  for i := 1 to RawHeaders.Count do begin
 869    S := RawHeaders[i-1];
 870    if StrLIComp(PChar(HeaderName), PChar(S), Length(HeaderName)) = 0 then begin
 871      {strip off the header field name}
 872      HeaderFieldList.Add(Copy(S, Length(HeaderName) + 1, Length(S)));
 873      {unfold the header if continued on more than one line}
 874      if (i < RawHeaders.Count) then
 875        for j := i to Pred(RawHeaders.Count) do begin
 876          S := RawHeaders[j];
 877          if (Length(S) > 0) and (S[1] <> #09) and (S[1] <> ' ') then
 878            Break
 879          else
 880            HeaderFieldList.Add(S);
 881        end;
 882      Break;
 883    end;
 884  end;
 885end;*)
 886
 887{ Return multiple instance headers as string list }
 888(*procedure DecodeMultiHeader(const HeaderName : string;
 889                            RawHeaders, HeaderFieldList : TStringList);
 890
 891var
 892  S, S2 : string;
 893  i, j : Integer;
 894begin
 895  {find the next line containing the header field name}
 896  for i := 1 to RawHeaders.Count do begin
 897    S := RawHeaders[i-1];
 898    if StrLIComp(PChar(HeaderName), PChar(S), Length(HeaderName)) = 0 then begin
 899      if HeaderName <> strUserFields then begin                         {!!.11}
 900        {strip off the header field name}
 901        S := Copy(S, Length(HeaderName) + 1, Length(S));
 902        {unfold the header if continued on more than one line}
 903        if (i < RawHeaders.Count) then
 904          for j := i to Pred(RawHeaders.Count) do begin
 905            S2 := RawHeaders[j];
 906            if (Length(S2) > 0) and (S2[1] <> #09) and (S2[1] <> ' ') then
 907              Break
 908            else
 909              S := S + S2;
 910          end;
 911      end;                                                              {!!.11}
 912      HeaderFieldList.Add(S);
 913    end;
 914  end;
 915end;*)
 916
 917{ Add header string to raw headers }
 918procedure EncodeSingleHeader(const HeaderName : string;
 919                             RawHeaders : TStringList;
 920                             HeaderFieldStr : string);
 921begin
 922  if (HeaderFieldStr <> '') then
 923    RawHeaders.Add(HeaderName + HeaderFieldStr);
 924end;
 925
 926{ Unfold multiple line header and add to raw headers }
 927procedure EncodeListHeader(const HeaderName : string;
 928                           RawHeaders, HeaderFieldList : TStringList;
 929                           const Delim : string;
 930                           Fold : Boolean);
 931var
 932  S : string;
 933  i : Integer;
 934begin
 935  if (HeaderFieldList.Count > 0) then begin
 936    S := HeaderName;
 937    for i := 0 to Pred(HeaderFieldList.Count) do begin
 938      if (Length(S + HeaderFieldList[i]) > MaxLine) then begin
 939        RawHeaders.Add(S);
 940        S := #09;
 941      end;
 942      S := S + HeaderFieldList[i];
 943      if (i < HeaderFieldList.Count - 1) and (S <> '') then begin
 944        S := S + Delim;                                                {!!.14}
 945        if Fold then begin
 946          RawHeaders.Add(S);
 947          S := #09;
 948        end;
 949      end;
 950    end;
 951    RawHeaders.Add(S);
 952  end;
 953end;
 954
 955{ Add multiple instance header to raw headers }
 956procedure EncodeMultiHeader(const HeaderName : string;
 957                            RawHeaders, HeaderFieldList : TStringList;
 958                            Delim : AnsiChar;
 959                            Fold : Boolean);
 960var
 961  i, j : Integer;
 962  SL : TStringList;
 963  S : string;
 964begin
 965  if (HeaderFieldList.Count > 0) then
 966    for j := 1 to HeaderFieldList.Count do begin
 967      if not Fold then
 968        RawHeaders.Add(HeaderName + HeaderFieldList[j-1])
 969      else begin
 970        SL := TStringList.Create;
 971        try
 972          Parse(HeaderFieldList[j-1], Delim, SL);
 973          S := HeaderName;
 974          for i := 1 to SL.Count do begin
 975            S := S + SL[i-1];
 976            if (i < SL.Count) and (S <> '') then begin
 977{Begin !!.13}
 978              RawHeaders.Add(S);
 979              S := Delim;
 980{End !!.13}
 981            end;
 982          end;
 983        finally
 984          SL.Free;
 985        end;
 986        RawHeaders.Add(S);
 987      end;
 988    end;
 989end;
 990
 991{ Generate "unique" boundary string }
 992function GenerateBoundary : string;
 993var
 994  Temp : TDateTime;
 995begin
 996  Temp := Now;
 997  Randomize;
 998  Result := '_NextPart_' + IntToHex(Trunc(Temp), 8) + '-' +
 999    IntToHex(Trunc(Frac(Temp) * 10000), 8) + '-' +
1000    IntToHex(GetTickCount64, 8) + '-' + IntToHex(Random($FFFF), 4);
1001end;
1002
1003{ 16-bit CRC of stream between starting and ending offset }
1004function BinHexCRC(Stream : TStream; StartOffset, EndOffset : Longint) : Word;
1005var
1006  Crc : Word;
1007  InByte : Byte;
1008  ByteStream : TIpByteStream;
1009
1010  procedure DoCRC(b : Byte);
1011    {- carry CRC division on with next byte }
1012  var
1013    j : Byte;
1014    t : Boolean;
1015  begin
1016    for j := 1 to 8 do begin
1017      t := (Crc and $8000) <> 0;
1018      Crc := (Crc shl 1) xor (b shr 7);
1019      if t then
1020        Crc := Crc xor $1021;
1021      b := b shl 1;
1022    end;
1023  end;
1024
1025begin
1026  if (StartOffset > Stream.Size) or (EndOffset > Stream.Size) then
1027    raise EIpBaseException.Create(SBadOffset);
1028
1029  Crc := 0;
1030  Stream.Position := StartOffset;
1031  ByteStream := TIpByteStream.Create(Stream);
1032  try
1033    while (ByteStream.Position < EndOffset) do begin
1034      if ByteStream.Read(InByte) then
1035        DoCrc(InByte);
1036    end;
1037  finally
1038    ByteStream.Free;
1039  end;
1040  DoCrc(0);
1041  DoCrc(0);
1042  Result := Swap(Crc);
1043end;
1044
1045{ Reverse bytes and words }
1046function htonl(HostLong : Longint) : Longint;
1047var
1048  dw : Longint;
1049  wa : array[0..1] of Word absolute dw;
1050  w  : Word;
1051begin
1052  dw := HostLong;
1053  w := wa[0];
1054  wa[0] := Swap(wa[1]);
1055  wa[1] := Swap(w);
1056  Result := dw;
1057end;
1058
1059{Begin !!.12}
1060{ TIpHeaderItem ****************************************************** }
1061
1062constructor TIpHeaderItem.Create (Collection : TCollection);
1063begin
1064  inherited Create (Collection);
1065  FCollection := TIpHeaderCollection.Create (
1066                     TIpHeaderCollection(Collection).FOwner);
1067
1068  FValue := TStringList.Create;
1069  FName  := '';
1070  FProperty := False;                                                  {!!.13}
1071end;                                                                     
1072
1073destructor TIpHeaderItem.Destroy;                                        
1074begin                                                                    
1075  FCollection.Free;                                                      
1076  FCollection := nil;                                                    
1077
1078  FValue.Free;                                                           
1079  FValue := nil;                                                         
1080
1081  inherited Destroy;                                                     
1082end;                                                                     
1083
1084procedure TIpHeaderItem.SetName(const Name : string);
1085begin
1086  FName := Name;
1087  FNameL := LowerCase(Name);
1088end;
1089
1090procedure TIpHeaderItem.SetValue (v : TStringList);                      
1091begin                                                                    
1092  FValue.Assign (v);                                                     
1093end;                                                                     
1094
1095{ TIpHeaderCollection ************************************************ } 
1096
1097constructor TIpHeaderCollection.Create(AOwner : TPersistent);            
1098begin                                                                    
1099  inherited Create (TIpHeaderItem);                                      
1100  FOwner := AOwner;                                                      
1101end;                                                                     
1102
1103{$IFNDEF VERSION5}                                                       
1104procedure TIpHeaderCollection.Delete(Item: integer);                     
1105begin                                                                    
1106  GetItem(Item).Free;                                                    
1107end;                                                                     
1108{$ENDIF}                                                                 
1109
1110function TIpHeaderCollection.GetItem (Index : Integer) : TIpHeaderItem;  
1111begin                                                                    
1112  Result := TIpHeaderItem (inherited GetItem (Index));                   
1113end;                                                                     
1114
1115function TIpHeaderCollection.GetOwner : TPersistent;                     
1116begin                                                                    
1117  Result := FOwner;                                                      
1118end;                                                                     
1119
1120function TIpHeaderCollection.HasHeader (AName : string) : Integer;
1121var                                                                      
1122  i : Integer;                                                           
1123begin                                                                    
1124  Result := -1;                                                          
1125  AName := LowerCase(AName);
1126  for i := 0 to Count - 1 do
1127    if Items[i].NameL = AName then begin                      
1128      Result := i;                                                       
1129      Break;                                                             
1130    end;                                                                 
1131end;                                                                     
1132
1133procedure TIpHeaderCollection.HeaderByName (AName   : string;            
1134                                            Headers : TStringList);      
1135var
1136  HeaderPos : Integer;                                                   
1137begin                                                                    
1138  Headers.Clear;                                                         
1139  HeaderPos := HasHeader (AName);                                        
1140  if HeaderPos >= 0 then                                                 
1141    Headers.Assign (Items[HeaderPos].Value);                             
1142end;                                                                     
1143
1144procedure TIpHeaderCollection.LoadHeaders (AHeaderList : TStringList;
1145                                           Append      : Boolean);
1146var
1147  CurPos : Integer;
1148
1149  function ExtractHeaderName (const AName : string) : string;
1150  {!!.15 - replaced local variable i with inx in order to avoid confusion with
1151    variable i in parent routine. }
1152  var
1153    inx     : Integer;
1154    NameLen : Integer;
1155  begin
1156    Result := '';
1157    CurPos := 0;
1158
1159    inx := 0;
1160    NameLen := Length (AName);
1161    while (inx < NameLen) and (AName[inx + 1] <> ':') and
1162          (AName[inx + 1] >= #33) and (AName[inx + 1] <= #126) do
1163      Inc (inx);
1164    if (inx > 0) then
1165      Result := Copy (AName, 1, inx);
1166    CurPos := inx + 2;
1167  end;
1168
1169  function IsWrappedLine (AHeaderList : TStringList;
1170                          LineToCheck : Integer) : Boolean;
1171  begin
1172    if LineToCheck < AHeaderList.Count then begin
1173      if Length (AHeaderList[LineToCheck]) > 0 then begin
1174        if (AHeaderList[LineToCheck][1] = ' ') or
1175           (AHeaderList[LineToCheck][1] = #09) then
1176          Result := True
1177        else
1178          Result := False;
1179      end else
1180        Result := False;
1181    end else
1182      Result := False;
1183  end;
1184
1185  procedure GetFieldValue (    AHeaderList : TStringList;
1186                           var CurLine     : Integer;
1187                           var NewField    : TIpHeaderItem);
1188  var
1189    WorkLine : string;
1190    LineLen  : Integer;
1191
1192  begin
1193    if CurLine >= AHeaderList.Count then
1194      Exit;
1195    LineLen  := Length (AHeaderList[CurLine]);
1196    while (CurPos < LineLen) and
1197          ((AHeaderList[CurLine][CurPos] = ' ') or
1198           (AHeaderList[CurLine][CurPos] = #09)) do
1199      Inc (CurPos);
1200    WorkLine := Copy (AHeaderList[CurLine],
1201                      CurPos, LineLen - CurPos + 1);
1202{Begin !!.13}
1203    Inc(CurLine);
1204
1205    while IsWrappedLine (AHeaderList, CurLine) do begin
1206      WorkLine := WorkLine + #9 + Trim(AHeaderList[CurLine]);
1207      Inc(CurLine);
1208    end;
1209    NewField.Value.Add (Trim (WorkLine));
1210{End !!.13}
1211  end;
1212
1213var                                                                      
1214  i          : Integer;                                                  
1215  HeaderName : string;                                                   
1216  NewHeader  : TIpHeaderItem;                                            
1217begin                                                                    
1218  if not Append then                                                     
1219    Clear;
1220
1221  i := 0;                                                                
1222  while i < AHeaderList.Count do begin                                   
1223    HeaderName := ExtractHeaderName (AHeaderList[i]);                    
1224    if HeaderName <> '' then begin                                       
1225      NewHeader := TIpHeaderItem (Add);                                  
1226      NewHeader.Name := HeaderName;                                      
1227      GetFieldValue (AHeaderList, i, NewHeader);
1228{Begin !!.15}
1229    end
1230    else
1231      Inc(i);
1232{End !!.15}
1233  end;
1234end;                                                                     
1235
1236procedure TIpHeaderCollection.SetItem (Index : Integer;                  
1237                                       Value : TIpHeaderItem);           
1238begin                                                                    
1239  inherited SetItem (Index, Value);                                      
1240end;
1241{End !!.12}
1242
1243{ TIpMimeParts }
1244constructor TIpMimeParts.Create;
1245begin
1246  inherited Create;
1247  Entitys := TList.Create;
1248end;
1249
1250destructor TIpMimeParts.Destroy;
1251begin
1252  Clear;
1253  Entitys.Free;
1254  inherited Destroy;
1255end;
1256
1257{ Add Mime block to list }
1258function TIpMimeParts.Add(aEntity : TIpMimeEntity) : Integer;
1259begin
1260  Result := Entitys.Add(aEntity);
1261end;
1262
1263{ Clear list }
1264procedure TIpMimeParts.Clear;
1265var
1266  i : Integer;
1267begin
1268  for i := Pred(Entitys.Count) downto 0 do
1269    Delete(i);
1270end;
1271
1272{ Delete block from list }
1273procedure TIpMimeParts.Delete(aIndex : Integer);
1274begin
1275  if (aIndex >= 0) and (aIndex < Entitys.Count) then begin
1276    TIpMimeEntity(Entitys[aIndex]).Free;
1277  end;
1278end;
1279
1280{ Remove block from list }
1281function TIpMimeParts.Remove(aEntity : TIpMimeEntity) : Integer;
1282begin
1283  Result := Entitys.Remove(Pointer(aEntity));
1284end;
1285
1286{ Count property read access method }
1287function TIpMimeParts.GetCount : Integer;
1288begin
1289  Result := Entitys.Count;
1290end;
1291
1292{ Parts property read access method }
1293function TIpMimeParts.GetPart(aIndex : Integer) : TIpMimeEntity;
1294begin
1295  if (aIndex >= 0) and (aIndex < Entitys.Count) then
1296    Result := TIpMimeEntity(Entitys[aIndex])
1297  else
1298    Result := nil;
1299end;
1300
1301{ Returns list index of specified Mime block }
1302function TIpMimeParts.IndexOf(aEntity : TIpMimeEntity) : Integer;
1303begin
1304  Result := Entitys.IndexOf(aEntity);
1305end;
1306
1307
1308{ TIpMimeEntity }
1309constructor TIpMimeEntity.Create(ParentEntity : TIpMimeEntity);
1310begin
1311  inherited Create;
1312  FBody := TIpAnsiTextStream.CreateEmpty;
1313  FBody.Stream := TMemoryStream.Create;
1314  FMimeParts := TIpMimeParts.Create;
1315  FParent := ParentEntity;
1316  if (FParent <> nil) then
1317    FParentBoundary := FParent.Boundary;
1318end;
1319
1320destructor TIpMimeEntity.Destroy;
1321begin
1322  FMimeParts.Free;
1323  FBody.FreeStream;
1324  FBody.Free;
1325  if (FParent <> nil) then
1326    FParent.MimeParts.Remove(Self);
1327  inherited Destroy;
1328end;
1329
1330{ Clear Body property }
1331procedure TIpMimeEntity.ClearBody;
1332begin
1333  FBody.FreeStream;
1334  FBody.Stream := TMemoryStream.Create;
1335end;
1336
1337{Begin !!.12}
1338{ Clear Body property in preparation for large attachment }
1339procedure TIpMimeEntity.ClearBodyLargeAttach(const AttachmentSize : Longint);
1340var
1341  FileName : string;
1342  Strm : TIpMemMapStream;
1343begin
1344  FBody.FreeStream;
1345  FileName := GetTemporaryFile(GetTemporaryPath);
1346  if FileExistsUTF8(FileName) then
1347    DeleteFileUTF8(FileName);
1348  Strm := TIpMemMapStream.Create(FileName, False, True);
1349  Strm.Size := Trunc(AttachmentSize * 1.3695);
1350  Strm.Open;
1351  FBody.Stream := Strm;
1352end;
1353{End !!.12}
1354
1355{ Clear all properties }
1356procedure TIpMimeEntity.Clear;
1357begin
1358  ClearBody;
1359  FMimeParts.Clear;
1360  FBoundary := '';
1361  FCharacterSet := '';
1362  FContentDescription := '';
1363  FContentDispositionType := '';
1364  FContentID := '';
1365  FContentSubtype := '';
1366  FContentType := '';
1367  FContentTransferEncoding := emUnknown;
1368  FFileName := '';
1369  FIsMime := False;
1370  FIsMultipart := False;
1371  FMimeVersion := '';
1372  FEntityName := '';
1373  FRelatedType := '';                                                {!!.02}
1374  FRelatedSubtype := '';                                             {!!.02}
1375  FRelatedStart := '';                                               {!!.02}
1376  FRelatedStartInfo := '';                                           {!!.02}
1377end;
1378
1379{ Build Mime (and nested Mime) block(s) from incoming text stream }
1380function TIpMimeEntity.DecodeEntity(InStream : TIpAnsiTextStream) : string;
1381var
1382  Blk : TIpMimeEntity;
1383  RawHeaders : TStringList;
1384  Decoded : Boolean;                                                   {!!.12}
1385  i,                                                                   {!!.13}
1386  LeadingBlankLines : Integer;                                         {!!.13}
1387begin
1388  Decoded := False;                                                    {!!.12}
1389  LeadingBlankLines := 0;                                              {!!.13}
1390  { skip blank lines in front of mime headers or body }
1391  Result := InStream.ReadLine;
1392  while (Result = '') and not InStream.AtEndOfStream do begin
1393    inc(LeadingBlankLines);
1394    Result := InStream.ReadLine;
1395  end;
1396
1397  { decode mime headers if any }
1398{Begin !!.15}
1399  if (StrLIComp(PChar(strContent), PChar(Result), Length(strContent)) = 0) or
1400     (StrLIComp(PChar(strMimeVersion), PChar(Result),
1401                Length(strMimeVersion)) = 0) then begin
1402{End !!.15}
1403    RawHeaders := TStringList.Create;
1404    try
1405      repeat
1406        RawHeaders.Add(Result);
1407        Result := InStream.ReadLine;
1408      until (Result = '') or (InStream.AtEndOfStream);
1409      DecodeMimeHeaders(RawHeaders);
1410    finally
1411      RawHeaders.Free;
1412    end;
1413    Result := InStream.ReadLine;
1414    { skip blank lines between mime headers and mime body }
1415    while (Result = '') and not InStream.AtEndOfStream do
1416      Result := InStream.ReadLine;
1417  end;
1418
1419  { decode body - main loop }
1420{Begin !!.15}
1421  if (FParentBoundary <> '') and
1422     (Result = '--' + FParentBoundary) then
1423    { The body of this entity is empty & we are now positioned at the boundary
1424      marker for the next entity. }
1425    Decoded := True
1426  else
1427{End !!.15}
1428  while not (((FParentBoundary <> '') and                              {!!.12}
1429              (Result = '--' + FParentBoundary)                        {!!.12}
1430             ) or InStream.AtEndOfStream) do begin              …

Large files files are truncated, but you can click here to view the full file