Download fixed idmessagecodermime.pas

  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 11673: IdMessageCoderMIME.pas
  11. {
  12. { Rev 1.36 27.08.2004 22:03:58 Andreas Hausladen
  13. { speed optimization ("const" for string parameters)
  14. }
  15. {
  16. { Rev 1.35 8/15/04 5:41:00 PM RLebeau
  17. { Updated GetAttachmentFilename() to handle cases where Outlook puts spaces
  18. { between "name=" and the filename.
  19. {
  20. { Updated CheckAndSetType() to retreive the filename before checking the type.
  21. { This helps to detect all file attachments better, including "form-data"
  22. { attachments
  23. }
  24. {
  25. { Rev 1.34 8/11/04 1:32:52 AM RLebeau
  26. { Bug fix for TIdMessageDecoderMIME.GetAttachmentFilename()
  27. }
  28. {
  29. { Rev 1.33 8/10/04 1:41:48 PM RLebeau
  30. { Misc. tweaks
  31. }
  32. {
  33. Rev 1.32 6/11/2004 9:38:22 AM DSiders
  34. Added "Do not Localize" comments.
  35. }
  36. {
  37. { Rev 1.31 6/4/04 12:41:04 PM RLebeau
  38. { ContentTransferEncoding bug fix
  39. }
  40. {
  41. { Rev 1.30 29/05/2004 21:23:56 CCostelloe
  42. { Added support for decoding attachments with a Content-Transfer-Encoding of
  43. { binary
  44. }
  45. {
  46. { Rev 1.29 2004.05.20 1:39:12 PM czhower
  47. { Last of the IdStream updates
  48. }
  49. {
  50. { Rev 1.28 2004.05.20 11:36:56 AM czhower
  51. { IdStreamVCL
  52. }
  53. {
  54. { Rev 1.27 2004.05.20 11:13:00 AM czhower
  55. { More IdStream conversions
  56. }
  57. {
  58. { Rev 1.26 2004.05.19 3:06:40 PM czhower
  59. { IdStream / .NET fix
  60. }
  61. {
  62. { Rev 1.25 16/05/2004 18:55:26 CCostelloe
  63. { New TIdText/TIdAttachment processing
  64. }
  65. {
  66. { Rev 1.24 23/04/2004 20:50:24 CCostelloe
  67. { Paths removed from attachment filenames and invalid Windows filename chars
  68. { weeded out
  69. }
  70. {
  71. { Rev 1.23 04/04/2004 17:44:56 CCostelloe
  72. { Bug fix
  73. }
  74. {
  75. { Rev 1.22 03/04/2004 20:27:22 CCostelloe
  76. { Fixed bug where code assumed Content-Type always contained a filename for the
  77. { attachment.
  78. }
  79. {
  80. { Rev 1.21 2004.02.03 5:44:04 PM czhower
  81. { Name changes
  82. }
  83. {
  84. { Rev 1.20 1/31/2004 3:12:48 AM JPMugaas
  85. { Removed dependancy on Math unit. It isn't needed and is problematic in some
  86. { versions of Dlephi which don't include it.
  87. }
  88. {
  89. { Rev 1.19 1/22/2004 4:02:52 PM SPerry
  90. { fixed set problems
  91. }
  92. {
  93. { Rev 1.18 16/01/2004 17:42:56 CCostelloe
  94. { Added support for BinHex 4.0 encoding
  95. }
  96. {
  97. { Rev 1.17 5/12/2003 9:18:26 AM GGrieve
  98. { use WriteStringToStream
  99. }
  100. {
  101. { Rev 1.16 5/12/2003 12:31:16 AM GGrieve
  102. { Fis WriteBuffer - can't be used in DotNet
  103. }
  104. {
  105. Rev 1.15 10/17/2003 12:40:20 AM DSiders
  106. Added localization comments.
  107. }
  108. {
  109. { Rev 1.14 05/10/2003 16:41:54 CCostelloe
  110. { Restructured MIME boundary outputting
  111. }
  112. {
  113. { Rev 1.13 29/09/2003 13:07:48 CCostelloe
  114. { Second RandomRange replaced with Random
  115. }
  116. {
  117. { Rev 1.12 28/09/2003 22:56:30 CCostelloe
  118. { TIdMessageEncoderInfoMIME.InitializeHeaders now only sets ContentType if it
  119. { is ''
  120. }
  121. {
  122. { Rev 1.11 28/09/2003 21:06:52 CCostelloe
  123. { Recoded RandomRange to Random to suit D% and BCB5
  124. }
  125. {
  126. { Rev 1.10 26/09/2003 01:05:42 CCostelloe
  127. { Removed FIndyMultiPartAlternativeBoundary, IFndyMultiPartRelatedBoundary - no
  128. { longer needed. Added support for ContentTransferEncoding '8bit'. Changed
  129. { nested MIME decoding from finding boundary to finding 'multipart/'.
  130. }
  131. {
  132. { Rev 1.9 04/09/2003 20:46:38 CCostelloe
  133. { Added inclusion of =_ in boundary generation in
  134. { TIdMIMEBoundaryStrings.GenerateStrings
  135. }
  136. {
  137. { Rev 1.8 30/08/2003 18:39:58 CCostelloe
  138. { MIME boundaries changed to be random strings
  139. }
  140. {
  141. { Rev 1.7 07/08/2003 00:56:48 CCostelloe
  142. { ReadBody altered to allow lines over 16K (arises with long html parts)
  143. }
  144. {
  145. { Rev 1.6 2003.06.14 11:08:10 PM czhower
  146. { AV fix
  147. }
  148. {
  149. { Rev 1.5 6/14/2003 02:46:42 PM JPMugaas
  150. { Kudzu wanted the BeginDecode called after LDecoder was created and EndDecode
  151. { to be called just before LDecoder was destroyed.
  152. }
  153. {
  154. Rev 1.4 6/14/2003 1:14:12 PM BGooijen
  155. fix for the bug where the attachments are empty
  156. }
  157. {
  158. { Rev 1.3 6/13/2003 07:58:46 AM JPMugaas
  159. { Should now compile with new decoder design.
  160. }
  161. {
  162. { Rev 1.2 5/23/03 11:24:06 AM RLebeau
  163. { Fixed a compiler error for previous changes
  164. }
  165. {
  166. { Rev 1.1 5/23/03 9:51:18 AM RLebeau
  167. { Fixed bug where message body is parsed incorrectly when MIMEBoundary is empty.
  168. }
  169. {
  170. { Rev 1.0 11/13/2002 07:57:08 AM JPMugaas
  171. }
  172. unit IdMessageCoderMIME;
  173.  
  174. {
  175. 2003-Oct-04 Ciaran Costelloe
  176. Moved boundary out of InitializeHeaders into TIdMessage.GenerateHeader
  177. }
  178.  
  179. // for all 3 to 4s:
  180. //// TODO: Predict output sizes and presize outputs, then use move on
  181. // presized outputs when possible, or presize only and reposition if stream
  182.  
  183. interface
  184.  
  185. uses
  186. Classes,
  187. IdMessageCoder, IdMessage, IdStream, IdStreamRandomAccess;
  188.  
  189. type
  190. TIdMessageDecoderMIME = class(TIdMessageDecoder)
  191. protected
  192. FFirstLine: string;
  193. FBodyEncoded: Boolean;
  194. FMIMEBoundary: string;
  195. public
  196. constructor Create(AOwner: TComponent); reintroduce; overload;
  197. constructor Create(AOwner: TComponent; const ALine: string); reintroduce; overload;
  198. function ReadBody(ADestStream: TIdStream;
  199. var VMsgEnd: Boolean): TIdMessageDecoder; override;
  200. procedure CheckAndSetType(AContentType, AContentDisposition: string);
  201. procedure ReadHeader; override;
  202. function GetAttachmentFilename(AContentType, AContentDisposition: string): string;
  203. function RemoveInvalidCharsFromFilename(const AFilename: string): string;
  204. //
  205. property MIMEBoundary: string read FMIMEBoundary write FMIMEBoundary;
  206. property BodyEncoded: Boolean read FBodyEncoded write FBodyEncoded;
  207. end;
  208.  
  209. TIdMessageDecoderInfoMIME = class(TIdMessageDecoderInfo)
  210. public
  211. function CheckForStart(ASender: TIdMessage; const ALine: string): TIdMessageDecoder; override;
  212. end;
  213.  
  214. TIdMessageEncoderMIME = class(TIdMessageEncoder)
  215. public
  216. procedure Encode(ASrc: TIdStreamRandomAccess; ADest: TIdStream); override;
  217. end;
  218.  
  219. TIdMessageEncoderInfoMIME = class(TIdMessageEncoderInfo)
  220. public
  221. constructor Create; override;
  222. procedure InitializeHeaders(AMsg: TIdMessage); override;
  223. end;
  224.  
  225. TIdMIMEBoundaryStrings = class
  226. private
  227. {CC2: After recoding SendBody et al, dont need FIndyMultiPartAlternativeBoundary
  228. or FIndyMultiPartRelatedBoundary.}
  229. FIndyMIMEBoundary: string;
  230. //FIndyMultiPartAlternativeBoundary: string;
  231. //FIndyMultiPartRelatedBoundary: string;
  232. procedure GenerateStrings;
  233. public
  234. function GenerateRandomChar: Char;
  235. function IndyMIMEBoundary: string;
  236. //function IndyMultiPartAlternativeBoundary: string;
  237. //function IndyMultiPartRelatedBoundary: string;
  238. end;
  239.  
  240. var
  241. //Note the following is created in the initialization section, so that the
  242. //overhead of boundary creation is only done at most once per session...
  243. IdMIMEBoundaryStrings: TIdMIMEBoundaryStrings;
  244.  
  245. const
  246. //NOTE: If you used IndyMIMEBoundary, just prefix it with "IdMIMEBoundaryStrings." now.
  247. //IndyMIMEBoundary = '=_NextPart_2rfkindysadvnqw3nerasdf'; {do not localize}
  248. //IndyMultiPartAlternativeBoundary = '=_NextPart_2altrfkindysadvnqw3nerasdf'; {do not localize}
  249. //IndyMultiPartRelatedBoundary = '=_NextPart_2relrfksadvnqindyw3nerasdf'; {do not localize}
  250. MIMEGenericText = 'text/'; {do not localize}
  251. MIMEGenericMultiPart = 'multipart/'; {do not localize}
  252. MIME7Bit = '7bit'; {do not localize}
  253. {Per Microsoft KnowledgeBase article KB 177506, the following are the only Windows chars permitted:}
  254. ValidWindowsFilenameChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890^&''@{}[],$=!-#()%.+~_'; {do not localize}
  255.  
  256. implementation
  257.  
  258. uses
  259. FileUtils, TntSysUtils,
  260. IdCoder, IdCoderMIME, IdGlobal, IdException, IdGlobalProtocols, IdResourceStrings,
  261. IdCoderQuotedPrintable, IdCoderBinHex4, SysUtils, IdCoderHeader;
  262.  
  263. { TIdMIMEBoundaryStrings }
  264.  
  265. function TIdMIMEBoundaryStrings.GenerateRandomChar: Char;
  266. var
  267. LOrd: integer;
  268. LFloat: Double;
  269. begin
  270. {Allow only digits (ASCII 48-57), uppercase letters (65-90) and lowercase
  271. letters (97-122), which is 62 possible chars...}
  272. LFloat := (Random * 61) + 1.5; //Gives us 1.5 to 62.5
  273. LOrd := Trunc(LFloat) + 47; //(1..62) -> (48..109)
  274. if LOrd > 83 then begin
  275. LOrd := LOrd + 13; {Move into lowercase letter range}
  276. end else if LOrd > 57 then begin
  277. LOrd := LOrd + 7; {Move into uppercase letter range}
  278. end;
  279. Result := Chr(LOrd);
  280. end;
  281.  
  282. procedure TIdMIMEBoundaryStrings.GenerateStrings;
  283. {This generates random MIME boundaries. They are only generated once each time
  284. a program containing this unit is run.}
  285. var
  286. LN: integer;
  287. LFloat: Double;
  288. begin
  289. {Generate a string 34 characters long (34 is a whim, not a requirement)...}
  290. FIndyMIMEBoundary := '1234567890123456789012345678901234'; {do not localize}
  291. Randomize;
  292. for LN := 1 to Length(FIndyMIMEBoundary) do begin
  293. FIndyMIMEBoundary[LN] := GenerateRandomChar;
  294. end;
  295. {CC2: RFC 2045 recommends including "=_" in the boundary, insert in random location...}
  296. //LN := RandomRange(1,Length(FIndyMIMEBoundary)-1);
  297. LFloat := (Random * (Length(FIndyMIMEBoundary) - 2)) + 1.5; //Gives us 1.5 to Length-0.5
  298. LN := Trunc(LFloat); // 1 to Length-1 (we are inserting a 2-char string)
  299. FIndyMIMEBoundary[LN] := '=';
  300. FIndyMIMEBoundary[LN + 1] := '_';
  301. {The Alternative boundary is the same with a random lowercase letter added...}
  302. //FIndyMultiPartAlternativeBoundary := FIndyMIMEBoundary + Chr(RandomRange(97,122));
  303. {The Related boundary is the same with a random uppercase letter added...}
  304. //FIndyMultiPartRelatedBoundary := FIndyMultiPartAlternativeBoundary + Chr(RandomRange(65,90));
  305. end;
  306.  
  307. function TIdMIMEBoundaryStrings.IndyMIMEBoundary: string;
  308. begin
  309. if FIndyMIMEBoundary = '' then begin
  310. GenerateStrings;
  311. end;
  312. Result := FIndyMIMEBoundary;
  313. end;
  314. {
  315. function TIdMIMEBoundaryStrings.IndyMultiPartAlternativeBoundary: string;
  316. begin
  317. if FIndyMIMEBoundary = '' then begin
  318. GenerateStrings;
  319. end;
  320. Result := FIndyMultiPartAlternativeBoundary;
  321. end;
  322. }
  323. {
  324. function TIdMIMEBoundaryStrings.IndyMultiPartRelatedBoundary: string;
  325. begin
  326. if FIndyMIMEBoundary = '' then begin
  327. GenerateStrings;
  328. end;
  329. Result := FIndyMultiPartRelatedBoundary;
  330. end;
  331. }
  332. { TIdMessageDecoderInfoMIME }
  333.  
  334. function TIdMessageDecoderInfoMIME.CheckForStart(ASender: TIdMessage;
  335. const ALine: string): TIdMessageDecoder;
  336. begin
  337. if ASender.MIMEBoundary.Boundary <> '' then begin
  338. if TextIsSame(ALine, '--' + ASender.MIMEBoundary.Boundary) then begin {Do not Localize}
  339. Result := TIdMessageDecoderMIME.Create(ASender);
  340. end else if TextIsSame(ASender.ContentTransferEncoding, 'base64') or {Do not Localize}
  341. TextIsSame(ASender.ContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  342. Result := TIdMessageDecoderMIME.Create(ASender, ALine);
  343. end else begin
  344. Result := nil;
  345. end;
  346. end else begin
  347. Result := nil;
  348. end;
  349. end;
  350.  
  351. { TIdCoderMIME }
  352.  
  353. constructor TIdMessageDecoderMIME.Create(AOwner: TComponent);
  354. begin
  355. inherited;
  356. FBodyEncoded := False;
  357. if AOwner is TIdMessage then begin
  358. FMIMEBoundary := TIdMessage(AOwner).MIMEBoundary.Boundary;
  359. {CC2: Check to see if this is an email of the type that is headers followed
  360. by the body encoded in base64 or quoted-printable. The problem with this type
  361. is that the header may state it as MIME, but the MIME parts and their headers
  362. will be encoded, so we won't find them - in this case, we will later take
  363. all the info we need from the message header, and not try to take it from
  364. the part header.}
  365. if (TIdMessage(AOwner).ContentTransferEncoding <> '') and
  366. {CC2: added 8bit below, changed to TextIsSame. Reason is that many emails
  367. set the Content-Transfer-Encoding to 8bit, have multiple parts, and display
  368. the part header in plain-text.}
  369. (not TextIsSame(TIdMessage(AOwner).ContentTransferEncoding, '8bit')) and {do not localize}
  370. (not TextIsSame(TIdMessage(AOwner).ContentTransferEncoding, '7bit')) and {do not localize}
  371. (not TextIsSame(TIdMessage(AOwner).ContentTransferEncoding, 'binary')) {do not localize}
  372. then
  373. begin
  374. FBodyEncoded := True;
  375. end;
  376. end;
  377. end;
  378.  
  379. constructor TIdMessageDecoderMIME.Create(AOwner: TComponent; const ALine: string);
  380. begin
  381. Create(AOwner);
  382. FFirstLine := ALine;
  383. end;
  384.  
  385. function TIdMessageDecoderMIME.ReadBody(ADestStream: TIdStream; var VMsgEnd: Boolean): TIdMessageDecoder;
  386. var
  387. LContentTransferEncoding: string;
  388. LDecoder: TIdDecoder;
  389. LLine: string;
  390. LBuffer: string; //Needed for binhex4 because cannot decode line-by-line.
  391. LIsThisTheFirstLine: Boolean; //Needed for binary encoding
  392. BoundaryStart, BoundaryEnd: string;
  393. IsBinaryContentTransferEncoding: Boolean;
  394. begin
  395. LIsThisTheFirstLine := True;
  396. VMsgEnd := False;
  397. Result := nil;
  398. if FBodyEncoded then begin
  399. LContentTransferEncoding := TIdMessage(Owner).ContentTransferEncoding;
  400. end else begin
  401. LContentTransferEncoding := FHeaders.Values['Content-Transfer-Encoding']; {Do not Localize}
  402. if LContentTransferEncoding = '' then begin
  403. LContentTransferEncoding := FHeaders.Values['Content-Type']; {Do not Localize}
  404. if TextIsSame(Copy(LContentTransferEncoding, 1, 24), 'application/mac-binhex40') then begin {Do not Localize}
  405. LContentTransferEncoding := 'binhex40'; {do not localize}
  406. end;
  407. end;
  408. end;
  409. if TextIsSame(LContentTransferEncoding, 'base64') then begin {Do not Localize}
  410. LDecoder := TIdDecoderMIME.Create(nil);
  411. end else if TextIsSame(LContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  412. LDecoder := TIdDecoderQuotedPrintable.Create(nil);
  413. end else if TextIsSame(LContentTransferEncoding, 'binhex40') then begin {Do not Localize}
  414. LDecoder := TIdDecoderBinHex4.Create(nil);
  415. end else begin
  416. LDecoder := nil;
  417. end;
  418. try
  419. if LDecoder <> nil then begin
  420. LDecoder.DecodeBegin(ADestStream);
  421. end;
  422.  
  423. BoundaryStart := '--' + MIMEBoundary; {Do not Localize}
  424. BoundaryEnd := BoundaryStart + '--'; {Do not Localize}
  425. IsBinaryContentTransferEncoding := TextIsSame(LContentTransferEncoding, 'binary'); {do not localize}
  426.  
  427. repeat
  428. if FFirstLine = '' then begin // TODO: Improve this. Not very efficient
  429. if IsBinaryContentTransferEncoding then begin
  430. //For binary, need EOL because the default LF causes spurious CRs in the output...
  431. LLine := ReadLn(EOL);
  432. end else begin
  433. LLine := ReadLn;
  434. end;
  435. end else begin
  436. LLine := FFirstLine;
  437. FFirstLine := ''; {Do not Localize}
  438. end;
  439. if LLine = '.' then begin // Do not use ADELIM since always ends with . (standard) {Do not Localize}
  440. VMsgEnd := True;
  441. Break;
  442. end;
  443. // New boundary - end self and create new coder
  444. if MIMEBoundary <> '' then begin
  445. if TextIsSame(LLine, BoundaryStart) then begin
  446. Result := TIdMessageDecoderMIME.Create(Owner);
  447. Break;
  448. // End of all coders (not quite ALL coders)
  449. end
  450. else if TextIsSame(LLine, BoundaryEnd) then begin
  451. // POP the boundary
  452. if Owner is TIdMessage then begin
  453. TIdMessage(Owner).MIMEBoundary.Pop;
  454. end;
  455. Break;
  456. // Data to save, but not decode
  457. end else if LDecoder = nil then begin
  458. if (LLine <> '') and (LLine[1] = '.') then begin // Process . in front for no encoding {Do not Localize}
  459. Delete(LLine, 1, 1);
  460. end;
  461. if IsBinaryContentTransferEncoding then begin {do not localize}
  462. //In this case, we have to make sure we dont write out an EOL at the
  463. //end of the file.
  464. if LIsThisTheFirstLine then begin
  465. ADestStream.Write(LLine);
  466. LIsThisTheFirstLine := False;
  467. end else begin
  468. ADestStream.Write(EOL);
  469. ADestStream.Write(LLine);
  470. end;
  471. end else begin
  472. LLine := LLine + EOL;
  473. ADestStream.Write(LLine);
  474. end;
  475. // Data to decode
  476. end else begin
  477. // For TIdDecoderQuotedPrintable, we have to make sure all EOLs are
  478. // intact
  479. if LDecoder is TIdDecoderQuotedPrintable then begin
  480. LDecoder.Decode(LLine + EOL);
  481. end else if LDecoder is TIdDecoderBinHex4 then begin
  482. //We cannot decode line-by-line because lines don't have a whole
  483. //number of 4-byte blocks due to the : inserted at the start of
  484. //the first line, so buffer the file...
  485. LBuffer := LBuffer + LLine;
  486. end else if LLine <> '' then begin
  487. LDecoder.Decode(LLine);
  488. end;
  489. end;
  490. end else begin {CC3: Added "else" for QP and base64 encoded message BODIES}
  491. // For TIdDecoderQuotedPrintable, we have to make sure all EOLs are
  492. // intact
  493. if LDecoder is TIdDecoderQuotedPrintable then begin
  494. LDecoder.Decode(LLine + EOL);
  495. end else if LDecoder = nil then begin
  496. if (LLine <> '') and (LLine[1] = '.') then begin // Process . in front for no encoding {Do not Localize}
  497. Delete(LLine, 1, 1);
  498. end;
  499. LLine := LLine + EOL;
  500. ADestStream.Write(LLine);
  501. end else if LLine <> '' then begin
  502. LDecoder.Decode(LLine);
  503. end;
  504. end;
  505. until False;
  506. if LDecoder <> nil then begin
  507. if LDecoder is TIdDecoderBinHex4 then begin
  508. //Now decode the complete block...
  509. LDecoder.Decode(LBuffer);
  510. end;
  511. LDecoder.DecodeEnd;
  512. end;
  513. finally FreeAndNil(LDecoder); end;
  514. end;
  515.  
  516.  
  517. function TIdMessageDecoderMIME.GetAttachmentFilename(AContentType, AContentDisposition: string): string;
  518. var
  519. LValue: string;
  520. LPos: Integer;
  521. begin
  522. LPos := IndyPos('FILENAME=', UpperCase(AContentDisposition)); {do not localize}
  523. if LPos > 0 then begin
  524. LValue := Trim(Copy(AContentDisposition, LPos + 9, MaxInt));
  525. end else begin
  526. LValue := ''; //FileName not found
  527. end;
  528. if Length(LValue) = 0 then begin
  529. // Get filename from Content-Type
  530. LPos := IndyPos('NAME=', UpperCase(AContentType)); {do not localize}
  531. if LPos > 0 then begin
  532. LValue := Trim(Copy(AContentType, LPos + 5, MaxInt)); {do not localize}
  533. end;
  534. end;
  535. if Length(LValue) > 0 then begin
  536. if LValue[1] = '"' then begin {do not localize}
  537. // RLebeau - shouldn't this code use AnsiExtractQuotedStr() instead?
  538. Fetch(LValue, '"'); {do not localize}
  539. Result := Fetch(LValue, '"'); {do not localize}
  540. end else begin
  541. // RLebeau - just in case the name is not the last field in the line
  542. Result := Fetch(LValue, ';'); {do not localize}
  543. end;
  544. // Result := RemoveInvalidCharsFromFilename(DecodeHeader(Result));
  545. Result := MakeCorrectFileName(WideExtractFileName(WideDecodeHeader(Result)));
  546. end else begin
  547. Result := '';
  548. end;
  549. end;
  550.  
  551. procedure TIdMessageDecoderMIME.CheckAndSetType(AContentType, AContentDisposition: string);
  552. var
  553. LDisposition, LFileName: string;
  554. begin
  555. LDisposition := Fetch(AContentDisposition, ';'); {Do not Localize}
  556.  
  557. {The new world order: Indy now defines a TIdAttachment as a part that either has
  558. a filename, or else does NOT have a ContentType starting with text/ or multipart/.
  559. Anything left is a TIdText.}
  560.  
  561. //WARNING: Attachments may not necessarily have filenames!
  562. LFileName := GetAttachmentFilename(AContentType, AContentDisposition);
  563.  
  564. if TextIsSame(LDisposition, 'attachment') or (Length(LFileName) > 0) then begin {Do not Localize}
  565. {A filename is specified, so irrespective of type, this is an attachment...}
  566. FPartType := mcptAttachment;
  567. FFilename := LFileName;
  568. end else begin
  569. {No filename is specified, so see what type the part is...}
  570. if TextIsSame(Copy(AContentType, 1, 5), MIMEGenericText) or
  571. TextIsSame(Copy(AContentType, 1, 10), MIMEGenericMultiPart) then
  572. begin
  573. FPartType := mcptText;
  574. end else begin
  575. FPartType := mcptAttachment;
  576. end;
  577. end;
  578. end;
  579.  
  580. procedure TIdMessageDecoderMIME.ReadHeader;
  581. var
  582. ABoundary,
  583. s: string;
  584. LLine: string;
  585. begin
  586. if FBodyEncoded then begin // Read header from the actual message since body parts don't exist {Do not Localize}
  587. CheckAndSetType(TIdMessage(Owner).ContentType, TIdMessage(OWner).ContentDisposition);
  588. end else begin
  589. // Read header
  590. repeat
  591. LLine := ReadLn;
  592. if LLine = '.' then begin // TODO: abnormal situation (Masters!) {Do not Localize}
  593. FPartType := mcptUnknown;
  594. Exit;
  595. end; //if
  596. if LLine = '' then begin
  597. Break;
  598. end;
  599. if CharIsInSet(LLine, 1, LWS) then begin
  600. if FHeaders.Count > 0 then begin
  601. FHeaders[FHeaders.Count - 1] := FHeaders[FHeaders.Count - 1] + ' ' + Copy(LLine, 2, MaxInt); {Do not Localize}
  602. end else begin
  603. //Make sure you change 'Content-Type :' to 'Content-Type:'
  604. FHeaders.Add(StringReplace(StringReplace(Copy(LLine, 2, MaxInt), ': ', '=', []), ' =', '=', [])); {Do not Localize}
  605. end;
  606. end else begin
  607. //Make sure you change 'Content-Type :' to 'Content-Type:'
  608. FHeaders.Add(StringReplace(StringReplace(LLine, ': ', '=', []), ' =', '=', [])); {Do not Localize}
  609. end;
  610. until False;
  611. s := FHeaders.Values['Content-Type']; {do not localize}
  612. //CC: Need to detect on "multipart" rather than boundary, because only the
  613. //"multipart" bit will be visible later...
  614. if TextIsSame(Copy(s, 1, 10), 'multipart/') then begin {do not localize}
  615. ABoundary := TIdMIMEBoundary.FindBoundary(s);
  616. if Owner is TIdMessage then begin
  617. if Length(ABoundary) > 0 then begin
  618. TIdMessage(Owner).MIMEBoundary.Push(ABoundary, TIdMessage(Owner).MessageParts.Count);
  619. // Also update current boundary
  620. FMIMEBoundary := ABoundary;
  621. end else begin
  622. //CC: We are in trouble. A multipart MIME Content-Type with no boundary?
  623. //Try pushing the current boundary...
  624. TIdMessage(Owner).MIMEBoundary.Push(FMIMEBoundary, TIdMessage(Owner).MessageParts.Count);
  625. end;
  626. end;
  627. end;
  628. CheckAndSetType(FHeaders.Values['Content-Type'], {do not localize}
  629. FHeaders.Values['Content-Disposition']); {do not localize}
  630. end;
  631. end;
  632.  
  633. function TIdMessageDecoderMIME.RemoveInvalidCharsFromFilename(const AFilename: string): string;
  634. var
  635. LN: integer;
  636. begin
  637. Result := AFilename;
  638. //First, strip any Windows or Unix path...
  639. for LN := Length(Result) downto 1 do begin
  640. if ((Result[LN] = '/') or (Result[LN] = '\')) then begin {do not localize}
  641. Result := Copy(Result, LN + 1, MAXINT);
  642. break;
  643. end;
  644. end;
  645. //Now remove any invalid filename chars.
  646. //Hmm - this code will be less buggy if I just replace them with _
  647. for LN := 1 to Length(Result) do begin
  648. if Pos(Result[LN], ValidWindowsFilenameChars) = 0 then begin
  649. Result[LN] := '_'; {do not localize}
  650. end;
  651. end;
  652. end;
  653.  
  654. { TIdMessageEncoderInfoMIME }
  655.  
  656. constructor TIdMessageEncoderInfoMIME.Create;
  657. begin
  658. inherited;
  659. FMessageEncoderClass := TIdMessageEncoderMIME;
  660. end;
  661.  
  662. procedure TIdMessageEncoderInfoMIME.InitializeHeaders(AMsg: TIdMessage);
  663. begin
  664. {CC2: The following logic does not work - it assumes that just because there
  665. are related parts, that the message header is multipart/related, whereas it
  666. could be multipart/related inside multipart/alternative, plus there are other
  667. issues.
  668. But...it works on simple emails, and it is better than throwing an exception.
  669. User must specify the ContentType to get the right results.}
  670. {CC4: removed addition of boundaries; now added at GenerateHeader stage (could
  671. end up with boundary added more than once)}
  672. if AMsg.ContentType = '' then begin
  673. if AMsg.MessageParts.RelatedPartCount > 0 then begin
  674. AMsg.ContentType := 'multipart/related; type="multipart/alternative"'; //; boundary="' + {do not localize}
  675. end else begin
  676. if AMsg.MessageParts.AttachmentCount > 0 then begin
  677. AMsg.ContentType := 'multipart/mixed'; //; boundary="' {do not localize}
  678. end else begin
  679. if AMsg.MessageParts.TextPartCount > 0 then begin
  680. AMsg.ContentType := 'multipart/alternative'; //; boundary="' {do not localize}
  681. end;
  682. end;
  683. end;
  684. end;
  685. end;
  686.  
  687. { TIdMessageEncoderMIME }
  688.  
  689. procedure TIdMessageEncoderMIME.Encode(ASrc: TIdStreamRandomAccess; ADest: TIdStream);
  690. var
  691. s: string;
  692. LEncoder: TIdEncoderMIME;
  693. LSPos, LSSize: Int64;
  694. begin
  695. ASrc.Position := 0;
  696. LSPos := 0;
  697. LSSize := ASrc.Size;
  698. LEncoder := TIdEncoderMIME.Create(nil); try
  699. while LSPos < LSSize do begin
  700. s := LEncoder.Encode(ASrc, 57) + EOL;
  701. Inc(LSPos, 57);
  702. ADest.Write(s);
  703. end;
  704. finally FreeAndNil(LEncoder); end;
  705. end;
  706.  
  707. initialization
  708. TIdMessageDecoderList.RegisterDecoder('MIME' {Do not Localize}
  709. , TIdMessageDecoderInfoMIME.Create);
  710. TIdMessageEncoderList.RegisterEncoder('MIME' {Do not Localize}
  711. , TIdMessageEncoderInfoMIME.Create);
  712. IdMIMEBoundaryStrings := TIdMIMEBoundaryStrings.Create;
  713. finalization
  714. IdMIMEBoundaryStrings.Free;
  715. IdMIMEBoundaryStrings := nil; {Global vars always initialised to 0, not nil}
  716. end.
  717.