/components/turbopower_ipro/ipmsg.pas
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