IdMessageClient.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.85 1/6/05 4:38:30 PM RLebeau
  18. Bug fix for decoding Text part headers
  19. }
  20. {
  21. Rev 1.84 11/30/04 10:44:44 AM RLebeau
  22. Bug fix for previous checkin
  23. }
  24. {
  25. Rev 1.83 11/30/2004 12:10:40 PM JPMugaas
  26. Fix for compiler error.
  27. }
  28. {
  29. Rev 1.82 11/28/04 2:22:04 PM RLebeau
  30. Updated a few hard-coded strings to use resource strings instead
  31. }
  32. {
  33. Rev 1.81 28/11/2004 20:08:14 CCostelloe
  34. MessagePart.Boundary now (correctly) holds decoded MIME boundary
  35. }
  36. {
  37. Rev 1.80 11/27/2004 8:58:14 PM JPMugaas
  38. Compile errors.
  39. }
  40. {
  41. Rev 1.79 10/26/2004 10:25:46 PM JPMugaas
  42. Updated refs.
  43. }
  44. {
  45. Rev 1.78 24.09.2004 02:16:48 Andreas Hausladen
  46. Added ReadTIdBytesFromStream and ReadCharFromStream function to supress .NET
  47. warnings.
  48. }
  49. {
  50. Rev 1.77 27.08.2004 22:04:32 Andreas Hausladen
  51. speed optimization ("const" for string parameters)
  52. Fixed "blank line multiplication"
  53. }
  54. {
  55. Rev 1.76 27.08.2004 00:21:32 Andreas Hausladen
  56. Undo last changes (temporary)
  57. }
  58. {
  59. Rev 1.75 26.08.2004 22:14:16 Andreas Hausladen
  60. Fixed last line blank line read/write bug
  61. }
  62. {
  63. Rev 1.74 7/23/04 7:17:20 PM RLebeau
  64. TFileStream access right tweak for ProcessMessage()
  65. }
  66. {
  67. Rev 1.73 28/06/2004 23:58:12 CCostelloe
  68. Bug fix
  69. }
  70. {
  71. Rev 1.72 6/11/2004 9:38:08 AM DSiders
  72. Added "Do not Localize" comments.
  73. }
  74. {
  75. Rev 1.71 2004.06.06 4:53:04 PM czhower
  76. Undid 1.70. Not needed, just masked an existing bug and did not fix it.
  77. }
  78. {
  79. Rev 1.70 06/06/2004 01:23:54 CCostelloe
  80. OnWork fix
  81. }
  82. {
  83. Rev 1.69 6/4/04 12:41:56 PM RLebeau
  84. ContentTransferEncoding bug fix
  85. }
  86. {
  87. Rev 1.68 2004.05.20 1:39:08 PM czhower
  88. Last of the IdStream updates
  89. }
  90. {
  91. Rev 1.67 2004.05.20 11:36:52 AM czhower
  92. IdStreamVCL
  93. }
  94. {
  95. Rev 1.66 2004.05.20 11:12:56 AM czhower
  96. More IdStream conversions
  97. }
  98. {
  99. Rev 1.65 2004.05.19 3:06:34 PM czhower
  100. IdStream / .NET fix
  101. }
  102. {
  103. Rev 1.64 19/05/2004 00:54:30 CCostelloe
  104. Bug fix (though I claim in my defence that it is only a hint fix)
  105. }
  106. {
  107. Rev 1.63 16/05/2004 18:55:06 CCostelloe
  108. New TIdText/TIdAttachment processing
  109. }
  110. {
  111. Rev 1.62 2004.05.03 11:15:16 AM czhower
  112. Fixed compile error and added use of constants.
  113. }
  114. {
  115. Rev 1.61 5/2/04 8:02:12 PM RLebeau
  116. Updated TIdIOHandlerStreamMsg to keep track of the last character received
  117. from the stream so that extra CR LF characters are not added to the end of
  118. the message data unnecessarily.
  119. }
  120. {
  121. Rev 1.60 4/23/04 1:54:58 PM RLebeau
  122. One more tweak for TIdIOHandlerStreamMsg support
  123. }
  124. {
  125. Rev 1.59 4/23/04 1:21:16 PM RLebeau
  126. Minor tweaks for TIdIOHandlerStreamMsg support
  127. }
  128. {
  129. Rev 1.58 23/04/2004 20:48:10 CCostelloe
  130. Added TIdIOHandlerStreamMsg to stop looping if no terminating \r\n.\r\n and
  131. added support for emails that are attachments only
  132. }
  133. {
  134. Rev 1.57 2004.04.18 1:39:22 PM czhower
  135. Bug fix for .NET with attachments, and several other issues found along the
  136. way.
  137. }
  138. {
  139. Rev 1.56 2004.04.16 11:31:00 PM czhower
  140. Size fix to IdBuffer, optimizations, and memory leaks
  141. Rev 1.55 2004.03.07 10:36:08 AM czhower
  142. SendMsg now calls OnWork with NoEncode = True
  143. Rev 1.54 2004.03.04 1:02:58 AM czhower
  144. Const removed from arguemtns (1 not needed + 1 incorrect)
  145. Rev 1.53 2004.03.03 7:18:32 PM czhower
  146. Fixed AV bug with ProcessMessage
  147. Rev 1.52 2004.03.03 11:54:34 AM czhower
  148. IdStream change
  149. Rev 1.51 2/3/04 12:25:50 PM RLebeau
  150. Updated WriteTextPart() function inside of SendBody() to write the ContentID
  151. property is it is assigned.
  152. Rev 1.50 2004.02.03 5:44:02 PM czhower
  153. Name changes
  154. Rev 1.49 2004.02.03 2:12:16 PM czhower
  155. $I path change
  156. Rev 1.48 1/27/2004 4:04:06 PM SPerry
  157. StringStream ->IdStringStream
  158. Rev 1.47 2004.01.27 12:03:28 AM czhower
  159. Properly named a local variable to fix a .net conflict.
  160. Rev 1.46 1/25/2004 3:52:32 PM JPMugaas
  161. Fixes for abstract SSL interface to work in NET.
  162. Rev 1.45 24/01/2004 19:24:30 CCostelloe
  163. Cleaned up warnings
  164. Rev 1.44 1/21/2004 1:30:06 PM JPMugaas
  165. InitComponent
  166. Rev 1.43 16/01/2004 17:39:34 CCostelloe
  167. Added support for BinHex 4.0 encoding
  168. Rev 1.42 11/01/2004 19:53:40 CCostelloe
  169. Revisions for TIdMessage SaveToFile & LoadFromFile for D7 & D8
  170. Rev 1.40 08/01/2004 23:46:16 CCostelloe
  171. Changes to ProcessMessage to get TIdMessage.LoadFromFile working in D7
  172. Rev 1.39 08/01/2004 00:31:06 CCostelloe
  173. Start of reimplementing LoadFrom/SaveToFile
  174. Rev 1.38 22/12/2003 00:44:52 CCostelloe
  175. .NET fixes
  176. Rev 1.37 11/11/2003 12:06:26 AM BGooijen
  177. Did all todo's ( TStream to TIdStream mainly )
  178. Rev 1.36 2003.10.24 10:43:10 AM czhower
  179. TIdSTream to dos
  180. Rev 1.35 10/17/2003 12:37:36 AM DSiders
  181. Added localization comments.
  182. Added resource string for exception message.
  183. Rev 1.34 2003.10.14 9:57:12 PM czhower
  184. Compile todos
  185. Rev 1.33 10/12/2003 1:49:56 PM BGooijen
  186. Changed comment of last checkin
  187. Rev 1.32 10/12/2003 1:43:40 PM BGooijen
  188. Changed IdCompilerDefines.inc to Core\IdCompilerDefines.inc
  189. Rev 1.30 10/11/2003 4:21:14 PM BGooijen
  190. Compiles in D7 again
  191. Rev 1.29 10/10/2003 10:42:28 PM BGooijen
  192. DotNet
  193. Rev 1.28 9/10/2003 1:50:52 PM SGrobety
  194. DotNet
  195. Rev 1.27 10/8/2003 9:53:42 PM GGrieve
  196. Remove $IFDEFs
  197. Rev 1.26 05/10/2003 16:39:52 CCostelloe
  198. Set default ContentType
  199. Rev 1.25 03/10/2003 21:03:40 CCostelloe
  200. Bug fixes
  201. Rev 1.24 2003.10.02 9:27:52 PM czhower
  202. DotNet Excludes
  203. Rev 1.23 01/10/2003 17:58:56 HHariri
  204. More fixes for Multipart Messages and also fixes for incorrect transfer
  205. encoding settings
  206. Rev 1.20 01/10/2003 10:57:56 CCostelloe
  207. Fixed GenerateTextPartContentType (was ignoring ContentType)
  208. Rev 1.19 26/09/2003 01:03:48 CCostelloe
  209. Modified ProcessAttachment in ReceiveBody to update message's Encoding if
  210. attachment was XX-encoded. Added decoding of message bodies encoded as
  211. base64 or quoted-printable. Added support for nested MIME parts
  212. (ParentPart). Added support for TIdText in UU and XX encoding. Added
  213. missing base64 and QP support where needed. Rewrote/rearranged most of code.
  214. Rev 1.18 04/09/2003 20:44:56 CCostelloe
  215. In SendBody, removed blank line between boundaries and Text part header;
  216. recoded wDoublePoint
  217. Rev 1.17 30/08/2003 18:40:44 CCostelloe
  218. Updated to use IdMessageCoderMIME's new random boundaries
  219. Rev 1.16 8/8/2003 12:27:18 PM JPMugaas
  220. Should now compile.
  221. Rev 1.15 07/08/2003 00:39:06 CCostelloe
  222. Modified SendBody to deal with unencoded attachments (otherwise 7bit
  223. attachments had the attachment header written out as 7bit but was encoded as
  224. base64)
  225. Rev 1.14 11/07/2003 01:14:20 CCostelloe
  226. SendHeader changed to support new IdMessage.GenerateHeader putting generated
  227. headers in IdMessage.LastGeneratedHeaders.
  228. Rev 1.13 6/15/2003 01:13:10 PM JPMugaas
  229. Minor fixes and cleanups.
  230. Rev 1.12 5/18/2003 02:31:44 PM JPMugaas
  231. Reworked some things so IdSMTP and IdDirectSMTP can share code including
  232. stuff for pipelining.
  233. Rev 1.11 5/8/2003 03:18:06 PM JPMugaas
  234. Flattened ou the SASL authentication API, made a custom descendant of SASL
  235. enabled TIdMessageClient classes.
  236. Rev 1.10 5/8/2003 11:28:02 AM JPMugaas
  237. Moved feature negoation properties down to the ExplicitTLSClient level as
  238. feature negotiation goes hand in hand with explicit TLS support.
  239. Rev 1.9 5/8/2003 02:17:58 AM JPMugaas
  240. Fixed an AV in IdPOP3 with SASL list on forms. Made exceptions for SASL
  241. mechanisms missing more consistant, made IdPOP3 support feature feature
  242. negotiation, and consolidated some duplicate code.
  243. Rev 1.8 3/17/2003 02:16:06 PM JPMugaas
  244. Now descends from ExplicitTLS base class.
  245. Rev 1.7 2/24/2003 07:25:18 PM JPMugaas
  246. Now compiles with new code.
  247. Rev 1.6 12-8-2002 21:12:36 BGooijen
  248. Changed calls to Writeln to IOHandler.WriteLn, because the parent classes
  249. don't provide Writeln, System.Writeln was assumed by the compiler
  250. Rev 1.5 12-8-2002 21:08:58 BGooijen
  251. The TIdIOHandlerStream was not Opened before used, fixed that.
  252. Rev 1.4 12/6/2002 05:30:22 PM JPMugaas
  253. Now decend from TIdTCPClientCustom instead of TIdTCPClient.
  254. Rev 1.3 12/5/2002 02:54:06 PM JPMugaas
  255. Updated for new API definitions.
  256. Rev 1.2 11/23/2002 03:33:44 AM JPMugaas
  257. Reverted changes because they were problematic. Kudzu didn't explain why.
  258. Rev 1.1 11/19/2002 05:35:30 PM JPMugaas
  259. Fixed problem with a line starting with a ".". A double period should only
  260. be used if the line is really just one "." and no other cases.
  261. Rev 1.0 11/13/2002 07:56:58 AM JPMugaas
  262. }
  263. unit IdMessageClient;
  264. {
  265. 2003-10-04 Ciaran Costelloe (see comments starting CC4)
  266. If attachment not base64 encoded and has no ContentType, set to text/plain
  267. 2003-Sep-20 Ciaran Costelloe
  268. Modified ProcessAttachment in ReceiveBody to update message's Encoding
  269. if attachment was XX-encoded. Added decoding of message bodies
  270. encoded as base64 or quoted-printable. Added support for nested MIME parts
  271. (ParentPart). Added support for TIdText in UU and XX encoding. Added
  272. missing base64 and QP support where needed.
  273. Rewrote/rearranged most of code.
  274. 2001-Oct-29 Don Siders
  275. Modified TIdMessageClient.SendMsg to use AHeadersOnly argument.
  276. 2001-Dec-1 Don Siders
  277. Save ContentDisposition in TIdMessageClient.ProcessAttachment
  278. 2003-Sep-04 Ciaran Costelloe (CC comments)
  279. Commented-out IOHandler.WriteLn(''); in SendBody which used to insert a blank line
  280. between boundary and text attachment header, causing the attachment header to
  281. be parsed as part of the attachment text (the blank line is the delimiter for
  282. the end of the header).
  283. 2003-Sep-11 Ciaran Costelloe (CC2 comments)
  284. Added support in decoding for message body (as distinct from message parts) being
  285. encoded.
  286. Added support for generating encoded message body.
  287. }
  288. interface
  289. {$i IdCompilerDefines.inc}
  290. uses
  291. Classes,
  292. IdCoderMIME,
  293. IdExplicitTLSClientServerBase,
  294. IdGlobal,
  295. IdHeaderList,
  296. IdIOHandlerStream,
  297. IdBaseComponent,
  298. IdMessage;
  299. type
  300. TIdIOHandlerStreamMsg = class(TIdIOHandlerStream)
  301. protected
  302. FTerminatorWasRead: Boolean;
  303. FEscapeLines: Boolean;
  304. FUnescapeLines: Boolean;
  305. FLastByteRecv: Byte;
  306. function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
  307. public
  308. constructor Create(
  309. AOwner: TComponent;
  310. AReceiveStream: TStream;
  311. ASendStream: TStream = nil
  312. ); override; //Should this be reintroduce instead of override?
  313. function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; override;
  314. function ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
  315. AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  316. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  317. ): string; override;
  318. procedure WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  319. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  320. ); override;
  321. property EscapeLines: Boolean read FEscapeLines write FEscapeLines;
  322. property UnescapeLines: Boolean read FUnescapeLines write FUnescapeLines;
  323. published
  324. property MaxLineLength default MaxInt;
  325. end;
  326. TIdMessageClient = class(TIdExplicitTLSClient)
  327. protected
  328. // The length of the folded line
  329. FMsgLineLength: integer;
  330. // The string to be pre-pended to the next line
  331. FMsgLineFold: string;
  332. procedure ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); virtual; {do not localize}
  333. function ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string; virtual;
  334. procedure SendBody(AMsg: TIdMessage); virtual;
  335. procedure SendHeader(AMsg: TIdMessage); virtual;
  336. procedure EncodeAndWriteText(const ABody: TStrings; AEncoding: IIdTextEncoding);
  337. procedure WriteFoldedLine(const ALine : string);
  338. procedure InitComponent; override;
  339. public
  340. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  341. constructor Create(AOwner: TComponent); reintroduce; overload;
  342. {$ENDIF}
  343. destructor Destroy; override;
  344. procedure ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False); overload;
  345. procedure ProcessMessage(AMsg: TIdMessage; AStream: TStream; AHeaderOnly: Boolean = False); overload;
  346. procedure ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False); overload;
  347. procedure SendMsg(AMsg: TIdMessage; AHeadersOnly: Boolean = False); overload; virtual;
  348. //
  349. // property Capabilities;
  350. property MsgLineLength: integer read FMsgLineLength write FMsgLineLength;
  351. property MsgLineFold: string read FMsgLineFold write FMsgLineFold;
  352. end;
  353. implementation
  354. uses
  355. //facilitate inlining only.
  356. {$IFDEF DOTNET}
  357. System.IO,
  358. {$ENDIF}
  359. //TODO: Remove these references and make it completely pluggable. Check other spots in Indy as well
  360. IdMessageCoderBinHex4, IdMessageCoderQuotedPrintable, IdMessageCoderMIME,
  361. IdMessageCoderUUE, IdMessageCoderXXE,
  362. //
  363. IdGlobalProtocols,
  364. IdCoderBinHex4,
  365. IdCoderHeader, IdHeaderCoderBase, IdMessageCoder, IdComponent, IdException,
  366. IdResourceStringsProtocols, IdTCPConnection, IdTCPStream, IdIOHandler,
  367. IdAttachment, IdText,
  368. SysUtils;
  369. const
  370. SContentType = 'Content-Type'; {do not localize}
  371. SContentTransferEncoding = 'Content-Transfer-Encoding'; {do not localize}
  372. SThisIsMultiPartMessageInMIMEFormat = 'This is a multi-part message in MIME format'; {do not localize}
  373. function GetLongestLine(var ALine : String; const ADelim : String) : String;
  374. var
  375. i, fnd, delimLen : Integer;
  376. begin
  377. Result := '';
  378. fnd := 0;
  379. delimLen := Length(ADelim);
  380. for i := 1 to Length(ALine) do
  381. begin
  382. if ALine[i] = ADelim[1] then
  383. begin
  384. if Copy(ALine, i, delimLen) = ADelim then
  385. begin
  386. fnd := i;
  387. end;
  388. end;
  389. end;
  390. if fnd > 0 then
  391. begin
  392. Result := Copy(ALine, 1, fnd - 1);
  393. ALine := Copy(ALine, fnd + delimLen, MaxInt);
  394. end;
  395. end;
  396. procedure RemoveLastBlankLine(Body: TStrings);
  397. var
  398. Count: Integer;
  399. begin
  400. if Assigned(Body) then begin
  401. { Remove the last blank line. The last blank line is added again in
  402. TIdMessageClient.SendBody(). }
  403. Count := Body.Count;
  404. if (Count > 0) and (Body[Count - 1] = '') then begin
  405. Body.Delete(Count - 1);
  406. end;
  407. end;
  408. end;
  409. ////////////////////////
  410. // TIdIOHandlerStreamMsg
  411. ////////////////////////
  412. constructor TIdIOHandlerStreamMsg.Create(
  413. AOwner: TComponent;
  414. AReceiveStream: TStream;
  415. ASendStream: TStream = nil
  416. );
  417. begin
  418. inherited Create(AOwner, AReceiveStream, ASendStream);
  419. FTerminatorWasRead := False;
  420. FEscapeLines := False; // do not set this to True! This is for users to set manually...
  421. FUnescapeLines := False; // do not set this to True! This is for users to set manually...
  422. FLastByteRecv := 0;
  423. MaxLineLength := MaxInt;
  424. end;
  425. function TIdIOHandlerStreamMsg.Readable(AMSec: integer = IdTimeoutDefault): Boolean;
  426. begin
  427. if not FTerminatorWasRead then begin
  428. Result := inherited Readable(AMSec);
  429. if Result then begin
  430. Exit;
  431. end;
  432. end;
  433. Result := ReceiveStream <> nil;
  434. end;
  435. function TIdIOHandlerStreamMsg.ReadDataFromSource(var VBuffer: TIdBytes): Integer;
  436. var
  437. LTerminator: String;
  438. begin
  439. if not FTerminatorWasRead then
  440. begin
  441. Result := inherited ReadDataFromSource(VBuffer);
  442. if Result > 0 then begin
  443. FLastByteRecv := VBuffer[Result-1];
  444. Exit;
  445. end;
  446. // determine whether the stream ended with a line
  447. // break, adding an extra CR and/or LF if needed...
  448. if (FLastByteRecv = Ord(LF)) then begin
  449. // don't add an extra line break
  450. LTerminator := '.' + EOL;
  451. end else if (FLastByteRecv = Ord(CR)) then begin
  452. // add extra LF
  453. LTerminator := LF + '.' + EOL;
  454. end else begin
  455. // add extra CRLF
  456. LTerminator := EOL + '.' + EOL;
  457. end;
  458. FTerminatorWasRead := True;
  459. // in theory, CopyTIdString() will write the string
  460. // into the byte array using 1-byte characters even
  461. // under DotNet where strings are usually Unicode
  462. // instead of ASCII...
  463. CopyTIdString(LTerminator, VBuffer, 0);
  464. Result := Length(LTerminator);
  465. end else begin
  466. Result := 0;
  467. end;
  468. end;
  469. function TIdIOHandlerStreamMsg.ReadLn(ATerminator: string;
  470. ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
  471. AByteEncoding: IIdTextEncoding = nil
  472. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  473. ): string;
  474. begin
  475. Result := inherited ReadLn(ATerminator, ATimeout, AMaxLineLength,
  476. AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  477. if FEscapeLines and TextStartsWith(Result, '.') and (not FTerminatorWasRead) then begin {Do not Localize}
  478. Result := '.' + Result; {Do not Localize}
  479. end;
  480. end;
  481. procedure TIdIOHandlerStreamMsg.WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  482. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  483. );
  484. var
  485. LOut: String;
  486. begin
  487. LOut := AOut;
  488. if FUnescapeLines and TextStartsWith(LOut, '..') then begin {Do not Localize}
  489. IdDelete(LOut, 1, 1);
  490. end;
  491. inherited WriteLn(LOut, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
  492. end;
  493. ///////////////////
  494. // TIdMessageClient
  495. ///////////////////
  496. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  497. constructor TIdMessageClient.Create(AOwner: TComponent);
  498. begin
  499. inherited Create(AOwner);
  500. end;
  501. {$ENDIF}
  502. procedure TIdMessageClient.InitComponent;
  503. begin
  504. inherited InitComponent;
  505. FMsgLineLength := 79;
  506. FMsgLineFold := TAB;
  507. end;
  508. procedure TIdMessageClient.WriteFoldedLine(const ALine : string);
  509. var
  510. ins, s, line, spare : String;
  511. msgLen, insLen : Word;
  512. begin
  513. s := ALine;
  514. // To give an amount of thread-safety
  515. ins := FMsgLineFold;
  516. insLen := Length(ins);
  517. msgLen := FMsgLineLength;
  518. // Do first line
  519. if length(s) > FMsgLineLength then
  520. begin
  521. spare := Copy(s, 1, msgLen);
  522. line := GetLongestLine(spare, ' '); {do not localize}
  523. s := spare + Copy(s, msgLen + 1, length(s));
  524. IOHandler.WriteLn(line);
  525. // continue with the folded lines
  526. while length(s) > (msgLen - insLen) do
  527. begin
  528. spare := Copy(s, 1, (msgLen - insLen));
  529. line := GetLongestLine(spare, ' '); {do not localize}
  530. s := ins + spare + Copy(s, (msgLen - insLen) + 1, length(s));
  531. IOHandler.WriteLn(line);
  532. end;
  533. // complete the output with what's left
  534. if Trim(s) <> '' then
  535. begin
  536. IOHandler.WriteLn(ins + s);
  537. end;
  538. end
  539. else begin
  540. IOHandler.WriteLn(s);
  541. end;
  542. end;
  543. procedure TIdMessageClient.ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); {do not localize}
  544. var
  545. LMsgEnd: Boolean;
  546. LActiveDecoder: TIdMessageDecoder;
  547. LLine: string;
  548. LParentPart: integer;
  549. LPreviousParentPart: integer;
  550. LEncoding, LCharsetEncoding: IIdTextEncoding;
  551. LContentTransferEncoding: string;
  552. LUnknownContentTransferEncoding: Boolean;
  553. // TODO - move this procedure into TIdIOHandler as a new Capture method?
  554. procedure CaptureAndDecodeCharset;
  555. var
  556. LMStream: TMemoryStream;
  557. begin
  558. LMStream := TMemoryStream.Create;
  559. try
  560. IOHandler.Capture(LMStream, ADelim, True, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
  561. LMStream.Position := 0;
  562. // TODO: when String is AnsiString, TIdIMAP4 uses 8bit as the destination
  563. // encoding, should this be doing the same? Otherwise, we could just use
  564. // AMsg.Body.LoadFromStream() instead...
  565. // TODO: if the Content-Type is HTML, parse the HTML data looking for a charset
  566. // declaration, and if found then use that instead of the MIME charset...
  567. ReadStringsAsCharSet(LMStream, AMsg.Body, AMsg.CharSet{$IFDEF STRING_IS_ANSI}, CharsetToEncoding(AMsg.CharSet){$ENDIF});
  568. finally
  569. FreeAndNil(LMStream);
  570. end;
  571. end;
  572. // RLebeau 11/2/2013: TIdMessage.Headers is a TIdHeaderList, but
  573. // TIdMessageDecoder.Headers is a plain TStringList. Although TIdHeaderList
  574. // is a TStrings descendant, it reintroduces its own Values[] property
  575. // instead of implementing the TStrings.Values[] property, so we cannot
  576. // access TIdMessage.Headers using a TStrings pointer or else the wrong
  577. // property will be invoked and we won't get the right value when accessing
  578. // TIdMessage.Headers since TStrings and TIdHeaderList use different
  579. // NameValueSeparator implementations, so we have to access them separately...
  580. function GetHeaderValue(const AName: string): string;
  581. begin
  582. if AMsg.IsMsgSinglePartMime then begin
  583. Result := AMsg.Headers.Values[AName];
  584. end else begin
  585. Result := LActiveDecoder.Headers.Values[AName];
  586. end;
  587. end;
  588. {Only set AUseBodyAsTarget to True if you want the input stream stored in TIdMessage.Body
  589. instead of TIdText.Body: this happens with some single-part messages.}
  590. procedure ProcessTextPart(var VDecoder: TIdMessageDecoder; AUseBodyAsTarget: Boolean);
  591. var
  592. LMStream: TMemoryStream;
  593. i: integer;
  594. LTxt : TIdText;
  595. LNewDecoder: TIdMessageDecoder;
  596. {$IFDEF STRING_IS_ANSI}
  597. LAnsiEncoding: IIdTextEncoding;
  598. {$ENDIF}
  599. begin
  600. LMStream := TMemoryStream.Create;
  601. try
  602. LParentPart := AMsg.MIMEBoundary.ParentPart;
  603. LNewDecoder := VDecoder.ReadBody(LMStream, LMsgEnd);
  604. try
  605. LMStream.Position := 0;
  606. if AUseBodyAsTarget then begin
  607. // TODO: if the Content-Type is HTML, parse the HTML data looking for a charset
  608. // declaration, and if found then use that instead of the MIME charset...
  609. if AMsg.IsMsgSinglePartMime then begin
  610. {$IFDEF STRING_IS_ANSI}
  611. LAnsiEncoding := CharsetToEncoding(AMsg.CharSet);
  612. {$ENDIF}
  613. ReadStringsAsCharSet(LMStream, AMsg.Body, AMsg.CharSet{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
  614. end else begin
  615. {$IFDEF STRING_IS_ANSI}
  616. LAnsiEncoding := ContentTypeToEncoding(VDecoder.Headers.Values[SContentType], QuoteMIME);
  617. {$ENDIF}
  618. ReadStringsAsContentType(LMStream, AMsg.Body, VDecoder.Headers.Values[SContentType], QuoteMIME{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
  619. end;
  620. end else begin
  621. LTxt := TIdText.Create(AMsg.MessageParts);
  622. try
  623. {$IFDEF STRING_IS_ANSI}
  624. LAnsiEncoding := ContentTypeToEncoding(GetHeaderValue(SContentType), QuoteMIME);
  625. {$ENDIF}
  626. ReadStringsAsContentType(LMStream, LTxt.Body, GetHeaderValue(SContentType), QuoteMIME{$IFDEF STRING_IS_ANSI}, LAnsiEncoding{$ENDIF});
  627. RemoveLastBlankLine(LTxt.Body);
  628. LTxt.ContentType := LTxt.ResolveContentType(GetHeaderValue(SContentType));
  629. LTxt.CharSet := LTxt.GetCharSet(GetHeaderValue(SContentType)); {do not localize}
  630. LTxt.ContentTransfer := GetHeaderValue(SContentTransferEncoding); {do not localize}
  631. LTxt.ContentID := GetHeaderValue('Content-ID'); {do not localize}
  632. LTxt.ContentLocation := GetHeaderValue('Content-Location'); {do not localize}
  633. LTxt.ContentDescription := GetHeaderValue('Content-Description'); {do not localize}
  634. LTxt.ContentDisposition := GetHeaderValue('Content-Disposition'); {do not localize}
  635. if not AMsg.IsMsgSinglePartMime then begin
  636. for i := 0 to VDecoder.Headers.Count-1 do begin
  637. if LTxt.Headers.IndexOfName(VDecoder.Headers.Names[i]) < 0 then begin
  638. LTxt.ExtraHeaders.AddValue(
  639. VDecoder.Headers.Names[i],
  640. IndyValueFromIndex(VDecoder.Headers, i)
  641. );
  642. end;
  643. end;
  644. end;
  645. LTxt.Filename := VDecoder.Filename;
  646. if IsHeaderMediaType(LTxt.ContentType, 'multipart') then begin {do not localize}
  647. LTxt.ParentPart := LPreviousParentPart;
  648. // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
  649. // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
  650. // permitted to have any value other than "7bit", "8bit" or "binary"."
  651. //
  652. // However, came across one message where the "Content-Type" was set to
  653. // "multipart/related" and the "Content-Transfer-Encoding" was set to
  654. // "quoted-printable". Outlook and Thunderbird were apparently able to parse
  655. // the message correctly, but Indy was not. So let's check for that scenario
  656. // and ignore illegal "Content-Transfer-Encoding" values if present...
  657. if LTxt.ContentTransfer <> '' then begin
  658. if not IsHeaderValue(LTxt.ContentTransfer, ['7bit', '8bit', 'binary']) then begin {do not localize}
  659. LTxt.ContentTransfer := '';
  660. end;
  661. end;
  662. end else begin
  663. LTxt.ParentPart := LParentPart;
  664. end;
  665. except
  666. LTxt.Free;
  667. raise;
  668. end;
  669. end;
  670. except
  671. LNewDecoder.Free;
  672. raise;
  673. end;
  674. VDecoder.Free;
  675. VDecoder := LNewDecoder;
  676. finally
  677. FreeAndNil(LMStream);
  678. end;
  679. end;
  680. procedure ProcessAttachment(var VDecoder: TIdMessageDecoder);
  681. var
  682. LDestStream: TStream;
  683. i: integer;
  684. LAttachment: TIdAttachment;
  685. LNewDecoder: TIdMessageDecoder;
  686. begin
  687. LParentPart := AMsg.MIMEBoundary.ParentPart;
  688. AMsg.DoCreateAttachment(VDecoder.Headers, LAttachment);
  689. Assert(Assigned(LAttachment), 'Attachment must not be unassigned here!'); {Do not localize}
  690. try
  691. LNewDecoder := nil;
  692. try
  693. LDestStream := LAttachment.PrepareTempStream;
  694. try
  695. LNewDecoder := VDecoder.ReadBody(LDestStream, LMsgEnd);
  696. finally
  697. LAttachment.FinishTempStream;
  698. end;
  699. LAttachment.ContentType := LAttachment.ResolveContentType(GetHeaderValue(SContentType));
  700. LAttachment.CharSet := LAttachment.GetCharSet(GetHeaderValue(SContentType));
  701. if VDecoder is TIdMessageDecoderUUE then begin
  702. LAttachment.ContentTransfer := TIdMessageDecoderUUE(VDecoder).CodingType; {do not localize}
  703. end else begin
  704. //Watch out for BinHex 4.0 encoding: no ContentTransfer is specified
  705. //in the header, but we need to set it to something meaningful for us...
  706. if IsHeaderMediaType(LAttachment.ContentType, 'application/mac-binhex40') then begin {do not localize}
  707. LAttachment.ContentTransfer := 'binhex40'; {do not localize}
  708. end else begin
  709. LAttachment.ContentTransfer := GetHeaderValue(SContentTransferEncoding);
  710. end;
  711. end;
  712. LAttachment.ContentDisposition := GetHeaderValue('Content-Disposition'); {do not localize}
  713. LAttachment.ContentID := GetHeaderValue('Content-ID'); {do not localize}
  714. LAttachment.ContentLocation := GetHeaderValue('Content-Location'); {do not localize}
  715. LAttachment.ContentDescription := GetHeaderValue('Content-Description'); {do not localize}
  716. if not AMsg.IsMsgSinglePartMime then begin
  717. for i := 0 to VDecoder.Headers.Count-1 do begin
  718. if LAttachment.Headers.IndexOfName(VDecoder.Headers.Names[i]) < 0 then begin
  719. LAttachment.ExtraHeaders.AddValue(
  720. VDecoder.Headers.Names[i],
  721. IndyValueFromIndex(VDecoder.Headers, i)
  722. );
  723. end;
  724. end;
  725. end;
  726. LAttachment.Filename := VDecoder.Filename;
  727. if IsHeaderMediaType(LAttachment.ContentType, 'multipart') then begin {do not localize}
  728. LAttachment.ParentPart := LPreviousParentPart;
  729. // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
  730. // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
  731. // permitted to have any value other than "7bit", "8bit" or "binary"."
  732. //
  733. // However, came across one message where the "Content-Type" was set to
  734. // "multipart/related" and the "Content-Transfer-Encoding" was set to
  735. // "quoted-printable". Outlook and Thunderbird were apparently able to parse
  736. // the message correctly, but Indy was not. So let's check for that scenario
  737. // and ignore illegal "Content-Transfer-Encoding" values if present...
  738. if LAttachment.ContentTransfer <> '' then begin
  739. if not IsHeaderValue(LAttachment.ContentTransfer, ['7bit', '8bit', 'binary']) then begin {do not localize}
  740. LAttachment.ContentTransfer := '';
  741. end;
  742. end;
  743. end else begin
  744. LAttachment.ParentPart := LParentPart;
  745. end;
  746. except
  747. LNewDecoder.Free;
  748. raise;
  749. end;
  750. VDecoder.Free;
  751. VDecoder := LNewDecoder;
  752. except
  753. //This should also remove the Item from the TCollection.
  754. //Note that Delete does not exist in the TCollection.
  755. LAttachment.Free;
  756. raise;
  757. end;
  758. end;
  759. begin
  760. LMsgEnd := False;
  761. // RLebeau 08/09/09 - TIdNNTP.GetBody() calls TIdMessage.Clear() before then
  762. // calling ReceiveBody(), thus the TIdMessage.ContentTransferEncoding value
  763. // is not available for use below. What is the best way to detect that so
  764. // the user could be allowed to set up the IOHandler.DefStringEncoding
  765. // beforehand?
  766. LUnknownContentTransferEncoding := False;
  767. if AMsg.NoDecode then begin
  768. LEncoding := IndyTextEncoding_8Bit;
  769. end else
  770. begin
  771. LContentTransferEncoding := ExtractHeaderItem(AMsg.ContentTransferEncoding);
  772. if LContentTransferEncoding = '' then begin
  773. // RLebeau 04/08/2014: According to RFC 2045 Section 6.1:
  774. // "Content-Transfer-Encoding: 7BIT" is assumed if the
  775. // Content-Transfer-Encoding header field is not present."
  776. if IsHeaderMediaType(AMsg.ContentType, 'application/mac-binhex40') then begin {Do not Localize}
  777. LContentTransferEncoding := 'binhex40'; {do not localize}
  778. end
  779. else if (AMsg.Encoding = meMIME) and (AMsg.MIMEBoundary.Count > 0) and (not AMsg.NoDecode) then begin
  780. LContentTransferEncoding := '7bit'; {do not localize}
  781. end;
  782. end
  783. else if IsHeaderMediaType(AMsg.ContentType, 'multipart') then {do not localize}
  784. begin
  785. // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
  786. // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
  787. // permitted to have any value other than "7bit", "8bit" or "binary"."
  788. //
  789. // However, came across one message where the "Content-Type" was set to
  790. // "multipart/related" and the "Content-Transfer-Encoding" was set to
  791. // "quoted-printable". Outlook and Thunderbird were apparently able to parse
  792. // the message correctly, but Indy was not. So let's check for that scenario
  793. // and ignore illegal "Content-Transfer-Encoding" values if present...
  794. if PosInStrArray(LContentTransferEncoding, ['7bit', '8bit', 'binary'], False) = -1 then begin {do not localize}
  795. LContentTransferEncoding := '';
  796. //LUnknownContentTransferEncoding := True;
  797. end;
  798. end;
  799. if LContentTransferEncoding <> '' then begin
  800. case PosInStrArray(LContentTransferEncoding, ['7bit', 'quoted-printable', 'base64', '8bit', 'binary'], False) of {do not localize}
  801. 0..2: LEncoding := IndyTextEncoding_ASCII;
  802. 3..4: LEncoding := IndyTextEncoding_8Bit;
  803. else
  804. // According to RFC 2045 Section 6.4:
  805. // "Any entity with an unrecognized Content-Transfer-Encoding must be
  806. // treated as if it has a Content-Type of "application/octet-stream",
  807. // regardless of what the Content-Type header field actually says."
  808. LEncoding := IndyTextEncoding_8Bit;
  809. LContentTransferEncoding := '';
  810. LUnknownContentTransferEncoding := True;
  811. end;
  812. end else begin
  813. LEncoding := IndyTextEncoding_8Bit;
  814. end;
  815. end;
  816. BeginWork(wmRead);
  817. try
  818. if AMsg.NoDecode then begin
  819. CaptureAndDecodeCharset;
  820. end else begin
  821. LActiveDecoder := nil;
  822. try
  823. if ((not LUnknownContentTransferEncoding) and
  824. ((AMsg.Encoding = meMIME) and (AMsg.MIMEBoundary.Count > 0)) or
  825. ((AMsg.Encoding = mePlainText) and (not IsHeaderValue(AMsg.ContentTransferEncoding, ['base64', 'quoted-printable']))) {do not localize}
  826. ) then begin
  827. {NOTE: You hit this code path with multipart MIME messages and with
  828. plain-text messages (which may have UUE or XXE attachments embedded).}
  829. LCharsetEncoding := CharsetToEncoding(AMsg.CharSet);
  830. repeat
  831. {CC: This code assumes the preamble text (before the first boundary)
  832. is plain text. I cannot imagine it not being, but if it arises, lines
  833. will have to be decoded.}
  834. // TODO: need to figure out a way to handle both transfer encoding
  835. // and charset encoding together! Need to read the raw bytes into
  836. // an intermediate buffer of some kind using the transfer encoding,
  837. // and then decode the characters using the charset afterwards...
  838. //
  839. // Need to do this anyway because ReadLnRFC() processes the LF and
  840. // ADelim values in terms of the charset specified, which is wrong.
  841. // EBCDIC-based charsets totally break that logic! For example, cp1026
  842. // converts #10 (LF) to $25 instead of $0A during encoding, and converts
  843. // $0A (LF) and $2E ('.') to #$83 and #6 during decoding, etc. And what
  844. // if the charset is UTF-16 instead? So we need to read raw bytes into
  845. // a buffer, checking it for handling of line breaks, dot-transparency,
  846. // and message termination, and THEN decode whatever is left using the
  847. // charset...
  848. LLine := IOHandler.ReadLnRFC(LMsgEnd, LF, ADelim, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF});
  849. if LMsgEnd then begin
  850. Break;
  851. end;
  852. if LActiveDecoder = nil then begin
  853. LActiveDecoder := TIdMessageDecoderList.CheckForStart(AMsg, LLine);
  854. end;
  855. // Check again, the if above can set it.
  856. if LActiveDecoder = nil then begin
  857. LLine := LCharsetEncoding.GetString(ToBytes(LLine, IndyTextEncoding_8Bit{$IFDEF STRING_IS_ANSI}, IndyTextEncoding_8Bit{$ENDIF}));
  858. AMsg.Body.Add(LLine);
  859. end else begin
  860. RemoveLastBlankLine(AMsg.Body);
  861. while LActiveDecoder <> nil do begin
  862. LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
  863. LPreviousParentPart := AMsg.MIMEBoundary.ParentPart;
  864. LActiveDecoder.ReadHeader;
  865. case LActiveDecoder.PartType of
  866. mcptText: ProcessTextPart(LActiveDecoder, False);
  867. mcptAttachment: ProcessAttachment(LActiveDecoder);
  868. mcptIgnore: FreeAndNil(LActiveDecoder);
  869. mcptEOF: begin FreeAndNil(LActiveDecoder); LMsgEnd := True; end;
  870. end;
  871. end;
  872. end;
  873. until LMsgEnd;
  874. RemoveLastBlankLine(AMsg.Body);
  875. end else begin
  876. {These are single-part MIMEs, or else mePlainTexts with the body encoded QP/base64}
  877. AMsg.IsMsgSinglePartMime := True;
  878. LActiveDecoder := TIdMessageDecoderMime.Create(AMsg);
  879. LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
  880. // RLebeau: override what TIdMessageDecoderMime.InitComponent() assigns
  881. TIdMessageDecoderMime(LActiveDecoder).BodyEncoded := True;
  882. TIdMessageDecoderMime(LActiveDecoder).ReadHeader;
  883. case LActiveDecoder.PartType of
  884. mcptText: begin
  885. if LUnknownContentTransferEncoding then begin
  886. ProcessAttachment(LActiveDecoder);
  887. end else begin
  888. ProcessTextPart(LActiveDecoder, True); //Put the text into TIdMessage.Body
  889. end;
  890. end;
  891. mcptAttachment: ProcessAttachment(LActiveDecoder);
  892. mcptIgnore: FreeAndNil(LActiveDecoder);
  893. mcptEOF: FreeAndNil(LActiveDecoder);
  894. end;
  895. end;
  896. finally
  897. FreeAndNil(LActiveDecoder);
  898. end;
  899. end;
  900. finally
  901. EndWork(wmRead);
  902. end;
  903. end;
  904. procedure TIdMessageClient.SendHeader(AMsg: TIdMessage);
  905. begin
  906. AMsg.GenerateHeader;
  907. IOHandler.Write(AMsg.LastGeneratedHeaders);
  908. end;
  909. procedure TIdMessageClient.SendBody(AMsg: TIdMessage);
  910. var
  911. i: Integer;
  912. LAttachment: TIdAttachment;
  913. LBoundary: string;
  914. LDestStream: TStream;
  915. LStrStream: TStream;
  916. ISOCharset: string;
  917. HeaderEncoding: Char; { B | Q }
  918. LEncoder: TIdMessageEncoder;
  919. LLine: string;
  920. procedure EncodeStrings(AStrings: TStrings; AEncoderClass: TIdMessageEncoderClass; AByteEncoding: IIdTextEncoding
  921. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding{$ENDIF});
  922. var
  923. LStrings: TStringList;
  924. begin
  925. {$IFDEF STRING_IS_ANSI}
  926. EnsureEncoding(AAnsiEncoding, encOSDefault);
  927. {$ENDIF}
  928. LStrings := TStringList.Create; try
  929. LEncoder := AEncoderClass.Create(Self); try
  930. LStrStream := TMemoryStream.Create; try
  931. // RLebeau 10/06/2010: not using TStrings.SaveToStream() in D2009+
  932. // anymore, as it may save a BOM which we do not want here...
  933. WriteStringToStream(LStrStream, AStrings.Text, AByteEncoding{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF});
  934. LStrStream.Position := 0;
  935. LEncoder.Encode(LStrStream, LStrings);
  936. finally FreeAndNil(LStrStream); end;
  937. finally FreeAndNil(LEncoder); end;
  938. IOHandler.WriteRFCStrings(LStrings, False);
  939. finally FreeAndNil(LStrings); end;
  940. end;
  941. procedure EncodeAttachment(AAttachment: TIdAttachment; AEncoderClass: TIdMessageEncoderClass);
  942. var
  943. LAttachStream: TStream;
  944. begin
  945. LDestStream := TIdTCPStream.Create(Self, 8192); try
  946. LEncoder := AEncoderClass.Create(Self); try
  947. LEncoder.Filename := AAttachment.Filename;
  948. LAttachStream := AAttachment.OpenLoadStream; try
  949. LEncoder.Encode(LAttachStream, LDestStream);
  950. finally AAttachment.CloseLoadStream; end;
  951. finally FreeAndNil(LEncoder); end;
  952. finally FreeAndNil(LDestStream); end;
  953. end;
  954. procedure WriteTextPart(ATextPart: TIdText);
  955. var
  956. LEncoding: IIdTextEncoding;
  957. LFileName: String;
  958. begin
  959. if ATextPart.ContentType = '' then begin
  960. ATextPart.ContentType := 'text/plain'; {do not localize}
  961. end;
  962. // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
  963. // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
  964. // permitted to have any value other than "7bit", "8bit" or "binary"."
  965. //
  966. // However, came across one message where the "Content-Type" was set to
  967. // "multipart/related" and the "Content-Transfer-Encoding" was set to
  968. // "quoted-printable". Outlook and Thunderbird were apparently able to parse
  969. // the message correctly, but Indy was not. So let's check for that scenario
  970. // and ignore illegal "Content-Transfer-Encoding" values if present...
  971. if IsHeaderMediaType(ATextPart.ContentType, 'multipart') then begin {do not localize}
  972. if ATextPart.ContentTransfer <> '' then begin
  973. if not IsHeaderValue(ATextPart.ContentTransfer, ['7bit', '8bit', 'binary']) then begin {do not localize}
  974. ATextPart.ContentTransfer := '';
  975. end;
  976. end;
  977. end
  978. else if ATextPart.ContentTransfer = '' then begin
  979. ATextPart.ContentTransfer := 'quoted-printable'; {do not localize}
  980. end
  981. else if (not IsHeaderValue(ATextPart.ContentTransfer, ['quoted-printable', 'base64'])) {do not localize}
  982. and ATextPart.IsBodyEncodingRequired then
  983. begin
  984. ATextPart.ContentTransfer := '8bit'; {do not localize}
  985. end;
  986. if ATextPart.ContentDisposition = '' then begin
  987. ATextPart.ContentDisposition := 'inline'; {do not localize}
  988. end;
  989. // TODO: when STRING_IS_ANSI is defined, provide a way for the user to specify the AnsiString encoding for header values...
  990. LFileName := EncodeHeader(ExtractFileName(ATextPart.FileName), '', HeaderEncoding, ISOCharSet); {do not localize}
  991. if ATextPart.ContentType <> '' then begin
  992. IOHandler.Write('Content-Type: ' + ATextPart.ContentType); {do not localize}
  993. if ATextPart.CharSet <> '' then begin
  994. IOHandler.Write('; charset="' + ATextPart.CharSet + '"'); {do not localize}
  995. end;
  996. if LFileName <> '' then begin
  997. IOHandler.WriteLn(';'); {do not localize}
  998. IOHandler.Write(TAB + 'name="' + LFileName + '"'); {do not localize}
  999. end;
  1000. IOHandler.WriteLn;
  1001. end;
  1002. if ATextPart.ContentTransfer <> '' then begin
  1003. IOHandler.WriteLn(SContentTransferEncoding + ': ' + ATextPart.ContentTransfer); {do not localize}
  1004. end;
  1005. IOHandler.Write('Content-Disposition: ' + ATextPart.ContentDisposition); {do not localize}
  1006. if LFileName <> '' then begin
  1007. IOHandler.WriteLn(';'); {do not localize}
  1008. IOHandler.Write(TAB + 'filename="' + LFileName + '"'); {do not localize}
  1009. end;
  1010. IOHandler.WriteLn;
  1011. if ATextPart.ContentID <> '' then begin
  1012. IOHandler.WriteLn('Content-ID: ' + ATextPart.ContentID); {do not localize}
  1013. end;
  1014. if ATextPart.ContentDescription <> '' then begin
  1015. IOHandler.WriteLn('Content-Description: ' + ATextPart.ContentDescription); {do not localize}
  1016. end;
  1017. IOHandler.Write(ATextPart.ExtraHeaders);
  1018. IOHandler.WriteLn;
  1019. LEncoding := CharsetToEncoding(ATextPart.CharSet);
  1020. case PosInStrArray(ExtractHeaderItem(ATextPart.ContentTransfer), ['quoted-printable', 'base64'], False) of {do not localize}
  1021. 0: EncodeStrings(ATextPart.Body, TIdMessageEncoderQuotedPrintable, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
  1022. 1: EncodeStrings(ATextPart.Body, TIdMessageEncoderMIME, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
  1023. else
  1024. IOHandler.WriteRFCStrings(ATextPart.Body, False, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
  1025. { No test for last line break necessary because IOHandler.WriteRFCStrings() uses WriteLn(). }
  1026. end;
  1027. end;
  1028. var
  1029. LFileName, LContentTransferEncoding: String;
  1030. LTextPart: TIdText;
  1031. LAddedTextPart: Boolean;
  1032. LLastPart: Integer;
  1033. LEncoding: IIdTextEncoding;
  1034. LAttachStream: TStream;
  1035. begin
  1036. LBoundary := '';
  1037. AMsg.InitializeISO(HeaderEncoding, ISOCharSet);
  1038. BeginWork(wmWrite);
  1039. try
  1040. LContentTransferEncoding := ExtractHeaderItem(AMsg.ContentTransferEncoding);
  1041. if (not AMsg.IsMsgSinglePartMime) and
  1042. (PosInStrArray(LContentTransferEncoding, ['base64', 'quoted-printable'], False) <> -1) then {do not localize}
  1043. begin
  1044. //CC2: The user wants the body encoded.
  1045. if AMsg.MessageParts.Count > 0 then begin
  1046. //CC2: We cannot deal with parts within a body encoding (user has to do
  1047. //this manually, if the user really wants to). Note this should have been trapped in TIdMessage.GenerateHeader.
  1048. raise EIdException.Create(RSMsgClientInvalidForTransferEncoding); // TODO: create a new Exception class for this
  1049. end;
  1050. IOHandler.WriteLn; //This is the blank line after the headers
  1051. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
  1052. LEncoding := CharsetToEncoding(AMsg.CharSet);
  1053. //CC2: Now output AMsg.Body in the chosen encoding...
  1054. if TextIsSame(LContentTransferEncoding, 'base64') then begin {do not localize}
  1055. EncodeStrings(AMsg.Body, TIdMessageEncoderMIME, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
  1056. end else begin {'quoted-printable'}
  1057. EncodeStrings(AMsg.Body, TIdMessageEncoderQuotedPrintable, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
  1058. end;
  1059. end
  1060. else if AMsg.Encoding = mePlainText then begin
  1061. IOHandler.WriteLn; //This is the blank line after the headers
  1062. //CC2: It is NOT Mime. It is a body followed by optional attachments
  1063. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
  1064. // Write out Body first
  1065. LEncoding := CharsetToEncoding(AMsg.CharSet);
  1066. EncodeAndWriteText(AMsg.Body, LEncoding);
  1067. IOHandler.WriteLn;
  1068. if AMsg.MessageParts.Count > 0 then begin
  1069. //The message has attachments.
  1070. for i := 0 to AMsg.MessageParts.Count - 1 do begin
  1071. //CC: Added support for TIdText...
  1072. if AMsg.MessageParts.Items[i] is TIdText then begin
  1073. IOHandler.WriteLn;
  1074. IOHandler.WriteLn('------- Start of text attachment -------'); {do not localize}
  1075. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
  1076. WriteTextPart(TIdText(AMsg.MessageParts.Items[i]));
  1077. IOHandler.WriteLn('------- End of text attachment -------'); {do not localize}
  1078. end
  1079. else if AMsg.MessageParts.Items[i] is TIdAttachment then begin
  1080. LAttachment := TIdAttachment(AMsg.MessageParts[i]);
  1081. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingAttachment]);
  1082. if LAttachment.ContentTransfer = '' then begin
  1083. //The user has nothing specified: see has he set a preference in
  1084. //TIdMessage.AttachmentEncoding (AttachmentEncoding is really an
  1085. //old and somewhat deprecated property, but we can still support it)...
  1086. if PosInStrArray(AMsg.AttachmentEncoding, ['UUE', 'XXE']) <> -1 then begin {do not localize}
  1087. LAttachment.ContentTransfer := AMsg.AttachmentEncoding;
  1088. end else begin
  1089. //We default to UUE (rather than XXE)...
  1090. LAttachment.ContentTransfer := 'UUE'; {do not localize}
  1091. end;
  1092. end;
  1093. case PosInStrArray(ExtractHeaderItem(LAttachment.ContentTransfer), ['UUE', 'XXE'], False) of {do not localize}
  1094. 0: EncodeAttachment(LAttachment, TIdMessageEncoderUUE);
  1095. 1: EncodeAttachment(LAttachment, TIdMessageEncoderXXE);
  1096. end;
  1097. end;
  1098. IOHandler.WriteLn;
  1099. end;
  1100. end;
  1101. end
  1102. else begin
  1103. //CC2: It is MIME-encoding...
  1104. LAddedTextPart := False;
  1105. //######### OUTPUT THE PREAMBLE TEXT ########
  1106. {For single-part MIME messages, we want the message part headers to be appended
  1107. to the message headers. Otherwise, add the blank separator between header and
  1108. body...}
  1109. if not AMsg.IsMsgSinglePartMime then begin
  1110. IOHandler.WriteLn; //This is the blank line after the headers
  1111. //if AMsg.Body.Count > 0 then begin
  1112. if not AMsg.IsBodyEmpty then begin
  1113. //CC2: The message has a body text. There are now a few possibilities.
  1114. //First up, if ConvertPreamble is False then the user explicitly does not want us
  1115. //to convert the .Body since he had to change it from the default False.
  1116. //Secondly, if AMsg.MessageParts.TextPartCount > 0, he may have put the
  1117. //message text in the part, so don't convert the body.
  1118. //Thirdly, if AMsg.MessageParts.Count = 0, then it has no other parts
  1119. //anyway: in this case, output it without boundaries.
  1120. //if (AMsg.ConvertPreamble and (AMsg.MessageParts.TextPartCount = 0)) then begin
  1121. if AMsg.ConvertPreamble and (AMsg.MessageParts.TextPartCount = 0) and (AMsg.MessageParts.Count > 0) then begin
  1122. //CC2: There is no text part, the user has not changed ConvertPreamble from
  1123. //its default of True, so the user has probably put his message into
  1124. //the body by mistake instead of putting it in a TIdText part.
  1125. //Create a TIdText part from the .Body text...
  1126. LTextPart := TIdText.Create(AMsg.MessageParts, AMsg.Body);
  1127. LTextPart.CharSet := AMsg.CharSet;
  1128. LTextPart.ContentType := 'text/plain'; {do not localize}
  1129. LTextPart.ContentTransfer := 'quoted-printable'; {do not localize}
  1130. //Have to remember that we added a text part, which is the last part
  1131. //in the collection, because we need it to be outputted first...
  1132. LAddedTextPart := True;
  1133. //CC2: Insert our standard preamble text...
  1134. IOHandler.WriteLn(SThisIsMultiPartMessageInMIMEFormat);
  1135. end else begin
  1136. //CC2: Hopefully the user has put suitable text in the preamble, or this
  1137. //is an already-received message which already has a preamble text...
  1138. LEncoding := CharsetToEncoding(AMsg.CharSet);
  1139. EncodeAndWriteText(AMsg.Body, LEncoding);
  1140. end;
  1141. end
  1142. else begin
  1143. //CC2: The user has specified no body text: he presumably has the message in
  1144. //a TIdText part, but it may have no text at all (a message consisting only
  1145. //of headers, which is allowed under the RFC, which will have a parts count
  1146. //of 0).
  1147. if AMsg.MessageParts.Count <> 0 then begin
  1148. //Add the "standard" MIME preamble text for non-html email clients...
  1149. IOHandler.WriteLn(SThisIsMultiPartMessageInMIMEFormat);
  1150. end;
  1151. end;
  1152. IOHandler.WriteLn;
  1153. //######### SET UP THE BOUNDARY STACK ########
  1154. LBoundary := AMsg.MIMEBoundary.Boundary;
  1155. if LBoundary = '' then begin
  1156. LBoundary := TIdMIMEBoundaryStrings.GenerateBoundary;
  1157. AMsg.MIMEBoundary.Push(LBoundary, -1); //-1 is "top level"
  1158. end;
  1159. end;
  1160. //######### OUTPUT THE PARTS ########
  1161. //CC2: Write the text parts in their order, if you change the order you
  1162. //can mess up mutipart sequences.
  1163. //The exception is due to ConvertPreamble, which may have added a text
  1164. //part at the end (the only place a TIdText part can be added), but it
  1165. //needs to be outputted first...
  1166. LLastPart := AMsg.MessageParts.Count - 1;
  1167. if LAddedTextPart then begin
  1168. IOHandler.WriteLn('--' + LBoundary); {do not localize}
  1169. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
  1170. WriteTextPart(AMsg.MessageParts.Items[LLastPart] as TIdText);
  1171. IOHandler.WriteLn;
  1172. Dec(LLastPart); //Don't output it again in the following "for" loop
  1173. end;
  1174. for i := 0 to LLastPart do begin
  1175. LLine := AMsg.MessageParts.Items[i].ContentType;
  1176. if IsHeaderMediaType(LLine, 'multipart') then begin {do not localize}
  1177. //A multipart header. Write out the CURRENT boundary first...
  1178. IOHandler.WriteLn('--' + LBoundary); {do not localize}
  1179. //Make the current boundary and this part number active...
  1180. //Now need to generate a new boundary...
  1181. LBoundary := TIdMIMEBoundaryStrings.GenerateBoundary;
  1182. AMsg.MIMEBoundary.Push(LBoundary, i);
  1183. //Make sure the header does not already have a pre-existing
  1184. //boundary since we just generated a new one...
  1185. IOHandler.WriteLn('Content-Type: ' + RemoveHeaderEntry(LLine, 'boundary', QuoteMIME) + ';'); {do not localize}
  1186. IOHandler.WriteLn(TAB + 'boundary="' + LBoundary + '"'); {do not localize}
  1187. IOHandler.WriteLn;
  1188. end
  1189. else begin
  1190. //Not a multipart header, see if it is a part change...
  1191. if not AMsg.IsMsgSinglePartMime then begin
  1192. while AMsg.MessageParts.Items[i].ParentPart <> AMsg.MIMEBoundary.ParentPart do begin
  1193. IOHandler.WriteLn('--' + LBoundary + '--'); {do not localize}
  1194. IOHandler.WriteLn;
  1195. AMsg.MIMEBoundary.Pop; //This also pops AMsg.MIMEBoundary.ParentPart
  1196. LBoundary := AMsg.MIMEBoundary.Boundary;
  1197. end;
  1198. IOHandler.WriteLn('--' + LBoundary); {do not localize}
  1199. end;
  1200. if AMsg.MessageParts.Items[i] is TIdText then begin
  1201. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingText]);
  1202. WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
  1203. IOHandler.WriteLn;
  1204. end
  1205. else if AMsg.MessageParts.Items[i] is TIdAttachment then begin
  1206. LAttachment := TIdAttachment(AMsg.MessageParts[i]);
  1207. {$IFDEF OVERLOADED_OPENARRAY_BUG}DoStatusArr{$ELSE}DoStatus{$ENDIF}(hsStatusText, [RSMsgClientEncodingAttachment]);
  1208. if LAttachment.ContentTransfer = '' then begin
  1209. LContentTransferEncoding := 'base64'; {do not localize}
  1210. LAttachment.ContentTransfer := LContentTransferEncoding;
  1211. end else begin;
  1212. LContentTransferEncoding := ExtractHeaderItem(LAttachment.ContentTransfer);
  1213. end;
  1214. if LAttachment.ContentDisposition = '' then begin
  1215. LAttachment.ContentDisposition := 'attachment'; {do not localize}
  1216. end;
  1217. if LAttachment.ContentType = '' then begin
  1218. if TextIsSame(LContentTransferEncoding, 'base64') then begin {do not localize}
  1219. LAttachment.ContentType := 'application/octet-stream'; {do not localize}
  1220. end else begin
  1221. {CC4: Set default type if not base64 encoded...}
  1222. LAttachment.ContentType := 'text/plain'; {do not localize}
  1223. end;
  1224. end;
  1225. // TODO: when STRING_IS_ANSI is defined, provide a way for the user to specify the AnsiString encoding for header values...
  1226. LFileName := EncodeHeader(ExtractFileName(LAttachment.FileName), '', HeaderEncoding, ISOCharSet); {do not localize}
  1227. if TextIsSame(LContentTransferEncoding, 'binhex40') then begin {do not localize}
  1228. //This is special - you do NOT write out any Content-Transfer-Encoding
  1229. //header! We also have to write a Content-Type specified in RFC 1741
  1230. //(overriding any ContentType present, if necessary).
  1231. LAttachment.ContentType := 'application/mac-binhex40'; {do not localize}
  1232. IOHandler.Write('Content-Type: ' + LAttachment.ContentType); {do not localize}
  1233. if LAttachment.CharSet <> '' then begin
  1234. IOHandler.Write('; charset="' + LAttachment.CharSet + '"'); {do not localize}
  1235. end;
  1236. if LFileName <> '' then begin
  1237. IOHandler.WriteLn(';'); {do not localize}
  1238. IOHandler.Write(TAB + 'name="' + LFileName + '"'); {do not localize}
  1239. end;
  1240. IOHandler.WriteLn;
  1241. end
  1242. else begin
  1243. IOHandler.Write('Content-Type: ' + LAttachment.ContentType); {do not localize}
  1244. if LAttachment.CharSet <> '' then begin
  1245. IOHandler.Write('; charset="' + LAttachment.CharSet + '"'); {do not localize}
  1246. end;
  1247. if LFileName <> '' then begin
  1248. IOHandler.WriteLn(';');
  1249. IOHandler.Write(TAB + 'name="' + LFileName + '"'); {do not localize}
  1250. end;
  1251. IOHandler.WriteLn;
  1252. IOHandler.WriteLn('Content-Transfer-Encoding: ' + LAttachment.ContentTransfer); {do not localize}
  1253. IOHandler.Write('Content-Disposition: ' + LAttachment.ContentDisposition); {do not localize}
  1254. if LFileName <> '' then begin
  1255. IOHandler.WriteLn(';');
  1256. IOHandler.Write(TAB + 'filename="' + LFileName + '"'); {do not localize}
  1257. end;
  1258. IOHandler.WriteLn;
  1259. end;
  1260. if LAttachment.ContentID <> '' then begin
  1261. IOHandler.WriteLn('Content-ID: '+ LAttachment.ContentID); {Do not Localize}
  1262. end;
  1263. if LAttachment.ContentDescription <> '' then begin
  1264. IOHandler.WriteLn('Content-Description: ' + LAttachment.ContentDescription); {Do not localize}
  1265. end;
  1266. IOHandler.Write(LAttachment.ExtraHeaders);
  1267. IOHandler.WriteLn;
  1268. case PosInStrArray(LContentTransferEncoding, ['base64', 'quoted-printable', 'binhex40'], False) of {do not localize}
  1269. 0: EncodeAttachment(LAttachment, TIdMessageEncoderMIME);
  1270. 1: EncodeAttachment(LAttachment, TIdMessageEncoderQuotedPrintable);
  1271. 2: EncodeAttachment(LAttachment, TIdMessageEncoderBinHex4);
  1272. else
  1273. begin
  1274. LEncoding := CharsetToEncoding(LAttachment.Charset);
  1275. LAttachStream := LAttachment.OpenLoadStream;
  1276. try
  1277. while ReadLnFromStream(LAttachStream, LLine, -1, LEncoding) do begin
  1278. IOHandler.WriteLnRFC(LLine, LEncoding);
  1279. end;
  1280. finally
  1281. LAttachment.CloseLoadStream;
  1282. end;
  1283. end;
  1284. end;
  1285. IOHandler.WriteLn;
  1286. end;
  1287. end;
  1288. end;
  1289. if AMsg.MessageParts.Count > 0 then begin
  1290. for i := 0 to AMsg.MIMEBoundary.Count - 1 do begin
  1291. if not AMsg.IsMsgSinglePartMime then begin
  1292. IOHandler.WriteLn('--' + AMsg.MIMEBoundary.Boundary + '--');
  1293. IOHandler.WriteLn;
  1294. end;
  1295. AMsg.MIMEBoundary.Pop;
  1296. end;
  1297. end;
  1298. end;
  1299. finally
  1300. EndWork(wmWrite);
  1301. end;
  1302. end;
  1303. procedure TIdMessageClient.SendMsg(AMsg: TIdMessage; AHeadersOnly: Boolean = False);
  1304. begin
  1305. BeginWork(wmWrite);
  1306. try
  1307. if AMsg.NoEncode then begin
  1308. IOHandler.Write(AMsg.Headers);
  1309. IOHandler.WriteLn;
  1310. if not AHeadersOnly then begin
  1311. IOHandler.WriteRFCStrings(AMsg.Body, False);
  1312. end;
  1313. end else begin
  1314. SendHeader(AMsg);
  1315. if (not AHeadersOnly) then begin
  1316. SendBody(AMsg);
  1317. end;
  1318. end;
  1319. finally
  1320. EndWork(wmWrite);
  1321. end;
  1322. end;
  1323. function TIdMessageClient.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
  1324. var
  1325. LMsgEnd: Boolean;
  1326. begin
  1327. BeginWork(wmRead);
  1328. try
  1329. repeat
  1330. Result := IOHandler.ReadLnRFC(LMsgEnd);
  1331. // Exchange Bug: Exchange sometimes returns . when getting a message instead of
  1332. // '' then a . - That is there is no seperation between the header and the message for an
  1333. // empty message.
  1334. if ((Length(AAltTerm) = 0) and LMsgEnd) or {do not localize}
  1335. ({APR: why? (Length(AAltTerm) > 0) and }(Result = AAltTerm)) then begin
  1336. Break;
  1337. end else if Result <> '' then begin
  1338. AMsg.Headers.Append(Result);
  1339. end;
  1340. until False;
  1341. AMsg.ProcessHeaders;
  1342. finally
  1343. EndWork(wmRead);
  1344. end;
  1345. end;
  1346. procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False);
  1347. begin
  1348. if IOHandler <> nil then begin
  1349. //Don't call ReceiveBody if the message ended at the end of the headers
  1350. //(ReceiveHeader() would have returned '.' in that case)...
  1351. BeginWork(wmRead);
  1352. try
  1353. if ReceiveHeader(AMsg) = '' then begin
  1354. if not AHeaderOnly then begin
  1355. ReceiveBody(AMsg);
  1356. end;
  1357. end;
  1358. finally
  1359. EndWork(wmRead);
  1360. end;
  1361. end;
  1362. end;
  1363. procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; AStream: TStream; AHeaderOnly: Boolean = False);
  1364. var
  1365. LIOHandler: TIdIOHandlerStreamMsg;
  1366. begin
  1367. LIOHandler := TIdIOHandlerStreamMsg.Create(nil, AStream);
  1368. try
  1369. LIOHandler.FreeStreams := False;
  1370. LIOHandler.MaxLineLength := MaxInt;
  1371. IOHandler := LIOHandler;
  1372. try
  1373. IOHandler.Open;
  1374. ProcessMessage(AMsg, AHeaderOnly);
  1375. finally
  1376. IOHandler := nil;
  1377. end;
  1378. finally
  1379. LIOHandler.Free;
  1380. end;
  1381. end;
  1382. procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False);
  1383. var
  1384. LStream: TStream;
  1385. begin
  1386. LStream := TIdReadFileExclusiveStream.Create(AFileName); try
  1387. ProcessMessage(AMsg, LStream, AHeaderOnly);
  1388. finally FreeAndNil(LStream); end;
  1389. end;
  1390. procedure TIdMessageClient.EncodeAndWriteText(const ABody: TStrings; AEncoding: IIdTextEncoding);
  1391. begin
  1392. Assert(ABody<>nil);
  1393. Assert(IOHandler<>nil);
  1394. // TODO: encode the text...
  1395. IOHandler.WriteRFCStrings(ABody, False, AEncoding);
  1396. end;
  1397. destructor TIdMessageClient.Destroy;
  1398. begin
  1399. inherited Destroy;
  1400. end;
  1401. end.