IdMessage.pas 49 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389
  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.53 29/12/2004 11:01:56 CCostelloe
  18. IsMsgSinglePartMime now cleared in TIdMessage.Clear.
  19. Rev 1.52 28/11/2004 20:06:28 CCostelloe
  20. Enhancement to preserve case of MIME boundary
  21. Rev 1.51 10/26/2004 10:25:44 PM JPMugaas
  22. Updated refs.
  23. Rev 1.50 2004.10.26 9:10:00 PM czhower
  24. TIdStrings
  25. Rev 1.49 24.08.2004 18:01:44 Andreas Hausladen
  26. Added AttachmentBlocked property to TIdAttachmentFile.
  27. Rev 1.48 6/29/04 12:29:04 PM RLebeau
  28. Updated TIdMIMEBoundary.FindBoundary() to check the string length after
  29. calling Sys.Trim() before referencing the string data
  30. Rev 1.47 6/9/04 5:38:48 PM RLebeau
  31. Updated ClearHeader() to clear the MsgId and UID properties.
  32. Updated SetUseNowForDate() to support AValue being set to False
  33. Rev 1.46 16/05/2004 18:54:42 CCostelloe
  34. New TIdText/TIdAttachment processing
  35. Rev 1.45 03/05/2004 20:43:08 CCostelloe
  36. Fixed bug where QP or base64 encoded text part got header encoding
  37. incorrectly outputted as 8bit.
  38. Rev 1.44 4/25/04 1:29:34 PM RLebeau
  39. Bug fix for SaveToStream
  40. Rev 1.42 23/04/2004 20:42:18 CCostelloe
  41. Bug fixes plus support for From containing multiple addresses
  42. Rev 1.41 2004.04.18 1:39:20 PM czhower
  43. Bug fix for .NET with attachments, and several other issues found along the
  44. way.
  45. Rev 1.40 2004.04.16 11:30:56 PM czhower
  46. Size fix to IdBuffer, optimizations, and memory leaks
  47. Rev 1.39 14/03/2004 17:47:54 CCostelloe
  48. Bug fix: quoted-printable attachment encoding was changed to base64.
  49. Rev 1.38 2004.02.03 5:44:00 PM czhower
  50. Name changes
  51. Rev 1.37 2004.02.03 2:12:14 PM czhower
  52. $I path change
  53. Rev 1.36 26/01/2004 01:51:14 CCostelloe
  54. Changed implementation of supressing BCC List generation
  55. Rev 1.35 25/01/2004 21:15:42 CCostelloe
  56. Added SuppressBCCListInHeader property for use by TIdSMTP
  57. Rev 1.34 1/21/2004 1:17:14 PM JPMugaas
  58. InitComponent
  59. Rev 1.33 1/19/04 11:36:02 AM RLebeau
  60. Updated GenerateHeader() to remove support for the BBCList property
  61. Rev 1.32 16/01/2004 17:30:18 CCostelloe
  62. Added support for BinHex4.0 encoding
  63. Rev 1.31 11/01/2004 19:53:20 CCostelloe
  64. Revisions for TIdMessage SaveToFile & LoadFromFile for D7 & D8
  65. Rev 1.29 08/01/2004 23:43:40 CCostelloe
  66. LoadFromFile/SaveToFile now work in D7 again
  67. Rev 1.28 1/7/04 11:07:16 PM RLebeau
  68. Bug fix for various TIdMessage properties that were not previously using
  69. setter methods correctly.
  70. Rev 1.27 08/01/2004 00:30:26 CCostelloe
  71. Start of reimplementing LoadFrom/SaveToFile
  72. Rev 1.26 21/10/2003 23:04:32 CCostelloe
  73. Bug fix: removed AttachmentEncoding := '' in SetEncoding.
  74. Rev 1.25 21/10/2003 00:33:04 CCostelloe
  75. meMIME changed to meDefault in TIdMessage.Create
  76. Rev 1.24 10/17/2003 7:42:54 PM BGooijen
  77. Changed default Encoding to MIME
  78. Rev 1.23 10/17/2003 12:14:08 AM DSiders
  79. Added localization comments.
  80. Rev 1.22 2003.10.14 9:57:04 PM czhower
  81. Compile todos
  82. Rev 1.21 10/12/2003 1:55:46 PM BGooijen
  83. Removed IdStrings from uses
  84. Rev 1.20 2003.10.11 10:01:26 PM czhower
  85. .inc path
  86. Rev 1.19 10/10/2003 10:42:26 PM BGooijen
  87. DotNet
  88. Rev 1.18 9/10/2003 1:50:54 PM SGrobety
  89. DotNet
  90. Rev 1.17 10/8/2003 9:53:12 PM GGrieve
  91. use IdCharsets
  92. Rev 1.16 05/10/2003 16:38:50 CCostelloe
  93. Restructured MIME boundary output
  94. Rev 1.15 2003.10.02 9:27:50 PM czhower
  95. DotNet Excludes
  96. Rev 1.14 01/10/2003 17:58:52 HHariri
  97. More fixes for Multipart Messages and also fixes for incorrect transfer
  98. encoding settings
  99. Rev 1.12 9/28/03 1:36:04 PM RLebeau
  100. Updated GenerateHeader() to support the BBCList property
  101. Rev 1.11 26/09/2003 00:29:34 CCostelloe
  102. IdMessage.Encoding now set when email decoded; XXencoded emails now decoded;
  103. logic added to GenerateHeader
  104. Rev 1.10 04/09/2003 20:42:04 CCostelloe
  105. GenerateHeader sets From's Name field to Address field if Name blank;
  106. trailing spaces removed after boundary in FindBoundary; force generation of
  107. InReplyTo header.
  108. Rev 1.9 29/07/2003 01:14:30 CCostelloe
  109. In-Reply-To fixed in GenerateHeader
  110. Rev 1.8 11/07/2003 01:11:02 CCostelloe
  111. GenerateHeader changed from function to procedure, results now put in
  112. LastGeneratedHeaders. Better for user (can see headers sent) and code still
  113. efficient.
  114. Rev 1.7 10/07/2003 22:39:00 CCostelloe
  115. Added LastGeneratedHeaders field and modified GenerateHeaders so that a copy
  116. of the last set of headers generated for this message is maintained (see
  117. comments starting "CC")
  118. Rev 1.6 2003.06.23 9:46:54 AM czhower
  119. Russian, Ukranian support for headers.
  120. Rev 1.5 6/3/2003 10:46:54 PM JPMugaas
  121. In-Reply-To header now supported.
  122. Rev 1.4 1/27/2003 10:07:46 PM DSiders
  123. Corrected error setting file stream permissions in LoadFromFile. Bug Report
  124. 649502.
  125. Rev 1.3 27/1/2003 3:07:10 PM SGrobety
  126. X-Priority header only added if priority <> mpNormal (because of spam filters)
  127. Rev 1.2 09/12/2002 18:19:00 ANeillans Version: 1.2
  128. Removed X-Library Line that was causing people problems with spam detection
  129. software , etc.
  130. Rev 1.1 12/5/2002 02:53:56 PM JPMugaas
  131. Updated for new API definitions.
  132. Rev 1.0 11/13/2002 07:56:52 AM JPMugaas
  133. 2004-05-04 Ciaran Costelloe
  134. - Replaced meUU with mePlainText. This also meant that UUE/XXE encoding was pushed
  135. down from the message-level to the MessagePart level, where it belongs.
  136. 2004-04-20 Ciaran Costelloe
  137. - Added support for multiple From addresses (per RFC 2822, section 3.6.2) by
  138. adding a FromList field. The previous From field now maps to FromList[0].
  139. 2003-10-04 Ciaran Costelloe (see comments starting CC4)
  140. 2003-09-20 Ciaran Costelloe (see comments starting CC2)
  141. - Added meDefault, meXX to TIdMessageEncoding.
  142. Code now sets TIdMessage.Encoding when it decodes an email.
  143. Modified TIdMIMEBoundary to work as a straight stack, now Push/Pops ParentPart also.
  144. Added meDefault, meXX to TIdMessageEncoding.
  145. Moved logic from SendBody to GenerateHeader, added extra logic to avoid exceptions:
  146. Change any encodings we dont know to base64
  147. We dont support attachments in an encoded body, change it to a supported combination
  148. Made changes to support ConvertPreamble and MIME message bodies with a
  149. ContentTransferEncoding of base64, quoted-printable.
  150. ProcessHeaders now decodes BCC list.
  151. 2003-09-02 Ciaran Costelloe
  152. - Added fix to FindBoundary suggested by Juergen Haible to remove trailing space
  153. after boundary added by some clients.
  154. 2003-07-10 Ciaran Costelloe
  155. - Added LastGeneratedHeaders property, see comments starting CC. Changed
  156. GenerateHeader from function to procedure, it now puts the generated headers
  157. into LastGeneratedHeaders, which is where dependant units should take the
  158. results from. This ensures that the headers that were generated are
  159. recorded, which some users' programs may need.
  160. 2002-12-09 Andrew Neillans
  161. - Removed X-Library line
  162. 2002-08-30 Andrew P.Rybin
  163. - Now InitializeISO is IdMessage method
  164. 2001-12-27 Andrew P.Rybin
  165. Custom InitializeISO, ExtractCharSet
  166. 2001-Oct-29 Don Siders
  167. Added EIdMessageCannotLoad exception.
  168. Added RSIdMessageCannotLoad constant.
  169. Added TIdMessage.LoadFromStream.
  170. Modified TIdMessage.LoadFromFile to call LoadFromStream.
  171. Added TIdMessage.SaveToStream.
  172. Modified TIdMessage.SaveToFile to call SaveToStream.
  173. Modified TIdMessage.GenerateHeader to include headers received but not used in properties.
  174. 2001-Sep-14 Andrew Neillans
  175. Added LoadFromFile Header only
  176. 2001-Sep-12 Johannes Berg
  177. Fixed upper/Sys.LowerCase in uses clause for Kylix
  178. 2001-Aug-09 Allen O'Neill
  179. Added line to check for valid charset value before adding second ';' after content-type boundry
  180. 2001-Aug-07 Allen O'Neill
  181. Added SaveToFile & LoadFromFile ... Doychin fixed
  182. 2001-Jul-11 Hadi Hariri
  183. Added Encoding for both MIME and UU.
  184. 2000-Jul-25 Hadi Hariri
  185. - Added support for MBCS
  186. 2000-Jun-10 Pete Mee
  187. - Fixed some minor but annoying bugs.
  188. 2000-May-06 Pete Mee
  189. - Added coder support directly into TIdMessage.
  190. }
  191. unit IdMessage;
  192. {
  193. 2001-Jul-11 Hadi Hariri
  194. TODO: Make checks for encoding and content-type later on.
  195. TODO: Add TIdHTML, TIdRelated
  196. TODO: CountParts on the fly
  197. TODO: Merge Encoding and AttachmentEncoding
  198. TODO: Make encoding plugable
  199. TODO: Clean up ISO header coding
  200. }
  201. { TODO : Moved Decode/Encode out and will add later,. Maybe TIdMessageEncode, Decode?? }
  202. { TODO : Support any header in TMessagePart }
  203. { DESIGN NOTE: The TIdMessage has an fBody which should only ever be the
  204. raw message. TIdMessage.fBody is only raw if TIdMessage.fIsEncoded = true
  205. The component parts are thus possibly made up of the following
  206. order of TMessagePart entries:
  207. MP[0] : Possible prologue text (fBoundary is '')
  208. MP[0 or 1 - depending on prologue existence] :
  209. fBoundary = boundary parameter from Content-Type
  210. MP[next...] : various parts with or without fBoundary = ''
  211. MP[MP.Count - 1] : Possible epilogue text (fBoundary is '')
  212. }
  213. { DESIGN NOTE: If TMessagePart.fIsEncoded = True, then TMessagePart.fBody
  214. is the encoded raw message part. Otherwise, it is the (decoded) text.
  215. }
  216. interface
  217. {$I IdCompilerDefines.inc}
  218. uses
  219. Classes,
  220. IdAttachment,
  221. IdBaseComponent,
  222. IdCoderHeader,
  223. IdEMailAddress,
  224. IdExceptionCore,
  225. IdHeaderList,
  226. IdMessageParts;
  227. type
  228. TIdMessagePriority = (mpHighest, mpHigh, mpNormal, mpLow, mpLowest);
  229. const
  230. ID_MSG_NODECODE = False;
  231. ID_MSG_USESNOWFORDATE = True;
  232. ID_MSG_PRIORITY = mpNormal;
  233. type
  234. TIdMIMEBoundary = class(TObject)
  235. protected
  236. FBoundaryList: TStrings;
  237. {CC: Added ParentPart as a TStrings so I dont have to create a TIntegers}
  238. FParentPartList: TStrings;
  239. function GetBoundary: string;
  240. function GetParentPart: integer;
  241. public
  242. constructor Create;
  243. destructor Destroy; override;
  244. procedure Push(ABoundary: string; AParentPart: integer);
  245. procedure Pop;
  246. procedure Clear;
  247. function Count: integer;
  248. property Boundary: string read GetBoundary;
  249. property ParentPart: integer read GetParentPart;
  250. end;
  251. TIdMessageFlags =
  252. ( mfAnswered, //Message has been answered.
  253. mfFlagged, //Message is "flagged" for urgent/special attention.
  254. mfDeleted, //Message is "deleted" for removal by later EXPUNGE.
  255. mfDraft, //Message has not completed composition (marked as a draft).
  256. mfSeen, //Message has been read.
  257. mfRecent ); //Message is "recently" arrived in this mailbox.
  258. TIdMessageFlagsSet = set of TIdMessageFlags;
  259. {WARNING: Replaced meUU with mePlainText in Indy 10 due to meUU being misleading.
  260. This is the MESSAGE-LEVEL "encoding", really the Sys.Format or layout of the message.
  261. When encoding, the user can let Indy decide on the encoding by leaving it at
  262. meDefault, or he can pick meMIME or mePlainText }
  263. //TIdMessageEncoding = (meDefault, meMIME, meUU, meXX);
  264. TIdMessageEncoding = (meDefault, meMIME, mePlainText);
  265. TIdInitializeIsoEvent = procedure (var VHeaderEncoding: Char;
  266. var VCharSet: string) of object;
  267. TIdMessage = class;
  268. TIdCreateAttachmentEvent = procedure(const AMsg: TIdMessage;
  269. const AHeaders: TStrings; var AAttachment: TIdAttachment) of object;
  270. TIdMessage = class(TIdBaseComponent)
  271. protected
  272. FAttachmentTempDirectory: string;
  273. FBccList: TIdEmailAddressList;
  274. FBody: TStrings;
  275. FCharSet: string;
  276. FCcList: TIdEmailAddressList;
  277. FContentType: string;
  278. FContentTransferEncoding: string;
  279. FContentDisposition: string;
  280. FDate: TDateTime;
  281. FIsEncoded : Boolean;
  282. FExtraHeaders: TIdHeaderList;
  283. FEncoding: TIdMessageEncoding;
  284. FFlags: TIdMessageFlagsSet;
  285. FFromList: TIdEmailAddressList;
  286. FHeaders: TIdHeaderList;
  287. FMessageParts: TIdMessageParts;
  288. FMIMEBoundary: TIdMIMEBoundary;
  289. FMsgId: string;
  290. FNewsGroups: TStrings;
  291. FNoEncode: Boolean;
  292. FNoDecode: Boolean;
  293. FOnInitializeISO: TIdInitializeISOEvent;
  294. FOrganization: string;
  295. FPriority: TIdMessagePriority;
  296. FSubject: string;
  297. FReceiptRecipient: TIdEmailAddressItem;
  298. FRecipients: TIdEmailAddressList;
  299. FReferences: string;
  300. FInReplyTo : String;
  301. FReplyTo: TIdEmailAddressList;
  302. FSender: TIdEMailAddressItem;
  303. FUID: String;
  304. FXProgram: string;
  305. FOnCreateAttachment: TIdCreateAttachmentEvent;
  306. FLastGeneratedHeaders: TIdHeaderList;
  307. FConvertPreamble: Boolean;
  308. FSavingToFile: Boolean;
  309. FIsMsgSinglePartMime: Boolean;
  310. FExceptionOnBlockedAttachments: Boolean; // used in TIdAttachmentFile
  311. //
  312. procedure DoInitializeISO(var VHeaderEncoding: Char; var VCharSet: String); virtual;
  313. function GetAttachmentEncoding: string;
  314. function GetInReplyTo: String;
  315. function GetUseNowForDate: Boolean;
  316. function GetFrom: TIdEmailAddressItem;
  317. procedure SetAttachmentEncoding(const AValue: string);
  318. procedure SetAttachmentTempDirectory(const Value: string);
  319. procedure SetBccList(const AValue: TIdEmailAddressList);
  320. procedure SetBody(const AValue: TStrings);
  321. procedure SetCCList(const AValue: TIdEmailAddressList);
  322. procedure SetContentType(const AValue: String);
  323. procedure SetEncoding(const AValue: TIdMessageEncoding);
  324. procedure SetExtraHeaders(const AValue: TIdHeaderList);
  325. procedure SetFrom(const AValue: TIdEmailAddressItem);
  326. procedure SetFromList(const AValue: TIdEmailAddressList);
  327. procedure SetHeaders(const AValue: TIdHeaderList);
  328. procedure SetInReplyTo(const AValue : String);
  329. procedure SetMsgID(const AValue : String);
  330. procedure SetNewsGroups(const AValue: TStrings);
  331. procedure SetReceiptRecipient(const AValue: TIdEmailAddressItem);
  332. procedure SetRecipients(const AValue: TIdEmailAddressList);
  333. procedure SetReplyTo(const AValue: TIdEmailAddressList);
  334. procedure SetSender(const AValue: TIdEmailAddressItem);
  335. procedure SetUseNowForDate(const AValue: Boolean);
  336. public
  337. constructor Create(AOwner: TComponent); override;
  338. destructor Destroy; override;
  339. procedure AddHeader(const AValue: string);
  340. procedure Clear; virtual;
  341. procedure ClearBody;
  342. procedure ClearHeader;
  343. procedure GenerateHeader; virtual;
  344. procedure InitializeISO(var VHeaderEncoding: Char; var VCharSet: String);
  345. function IsBodyEncodingRequired: Boolean;
  346. function IsBodyEmpty: Boolean;
  347. procedure LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False; const AUsesDotTransparency: Boolean = True);
  348. procedure LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False; const AUsesDotTransparency: Boolean = True);
  349. procedure ProcessHeaders; virtual;
  350. procedure SaveToFile(const AFileName : string; const AHeadersOnly: Boolean = False; const AUseDotTransparency: Boolean = True);
  351. procedure SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False; const AUseDotTransparency: Boolean = True);
  352. procedure DoCreateAttachment(const AHeaders: TStrings; var VAttachment: TIdAttachment); virtual;
  353. //
  354. property Flags: TIdMessageFlagsSet read FFlags write FFlags;
  355. property IsEncoded : Boolean read FIsEncoded write FIsEncoded;
  356. property MsgId: string read FMsgId write SetMsgID;
  357. property Headers: TIdHeaderList read FHeaders write SetHeaders;
  358. property MessageParts: TIdMessageParts read FMessageParts;
  359. property MIMEBoundary: TIdMIMEBoundary read FMIMEBoundary;
  360. property UID: String read FUID write FUID;
  361. property IsMsgSinglePartMime: Boolean read FIsMsgSinglePartMime write FIsMsgSinglePartMime;
  362. published
  363. //TODO: Make a property editor which drops down the registered coder types
  364. property AttachmentEncoding: string read GetAttachmentEncoding write SetAttachmentEncoding;
  365. property Body: TStrings read FBody write SetBody;
  366. property BccList: TIdEmailAddressList read FBccList write SetBccList;
  367. property CharSet: string read FCharSet write FCharSet;
  368. property CCList: TIdEmailAddressList read FCcList write SetCcList;
  369. property ContentType: string read FContentType write SetContentType;
  370. property ContentTransferEncoding: string read FContentTransferEncoding
  371. write FContentTransferEncoding;
  372. property ContentDisposition: string read FContentDisposition write FContentDisposition;
  373. property Date: TDateTime read FDate write FDate;
  374. //
  375. property Encoding: TIdMessageEncoding read FEncoding write SetEncoding;
  376. property ExtraHeaders: TIdHeaderList read FExtraHeaders write SetExtraHeaders;
  377. property FromList: TIdEmailAddressList read FFromList write SetFromList;
  378. property From: TIdEmailAddressItem read GetFrom write SetFrom;
  379. property NewsGroups: TStrings read FNewsGroups write SetNewsGroups;
  380. property NoEncode: Boolean read FNoEncode write FNoEncode default ID_MSG_NODECODE;
  381. property NoDecode: Boolean read FNoDecode write FNoDecode default ID_MSG_NODECODE;
  382. property Organization: string read FOrganization write FOrganization;
  383. property Priority: TIdMessagePriority read FPriority write FPriority default ID_MSG_PRIORITY;
  384. property ReceiptRecipient: TIdEmailAddressItem read FReceiptRecipient write SetReceiptRecipient;
  385. property Recipients: TIdEmailAddressList read FRecipients write SetRecipients;
  386. property References: string read FReferences write FReferences;
  387. property InReplyTo : String read GetInReplyTo write SetInReplyTo;
  388. property ReplyTo: TIdEmailAddressList read FReplyTo write SetReplyTo;
  389. property Subject: string read FSubject write FSubject;
  390. property Sender: TIdEmailAddressItem read FSender write SetSender;
  391. property UseNowForDate: Boolean read GetUseNowForDate write SetUseNowForDate default ID_MSG_USESNOWFORDATE;
  392. property LastGeneratedHeaders: TIdHeaderList read FLastGeneratedHeaders;
  393. property ConvertPreamble: Boolean read FConvertPreamble write FConvertPreamble;
  394. property ExceptionOnBlockedAttachments: Boolean read FExceptionOnBlockedAttachments write FExceptionOnBlockedAttachments default False;
  395. property AttachmentTempDirectory: string read FAttachmentTempDirectory write SetAttachmentTempDirectory;
  396. // Events
  397. property OnInitializeISO: TIdInitializeIsoEvent read FOnInitializeISO write FOnInitializeISO;
  398. property OnCreateAttachment: TIdCreateAttachmentEvent read FOnCreateAttachment write FOnCreateAttachment;
  399. End;
  400. TIdMessageEvent = procedure(ASender : TComponent; var AMsg : TIdMessage) of object;
  401. EIdTextInvalidCount = class(EIdMessageException);
  402. // 2001-Oct-29 Don Siders
  403. EIdMessageCannotLoad = class(EIdMessageException);
  404. const
  405. MessageFlags : array [mfAnswered..mfRecent] of String =
  406. ( '\Answered', {Do not Localize} //Message has been answered.
  407. '\Flagged', {Do not Localize} //Message is "flagged" for urgent/special attention.
  408. '\Deleted', {Do not Localize} //Message is "deleted" for removal by later EXPUNGE.
  409. '\Draft', {Do not Localize} //Message has not completed composition (marked as a draft).
  410. '\Seen', {Do not Localize} //Message has been read.
  411. '\Recent' ); {Do not Localize} //Message is "recently" arrived in this mailbox.
  412. INREPLYTO = 'In-Reply-To'; {Do not localize}
  413. implementation
  414. uses
  415. //facilitate inlining only.
  416. IdIOHandlerStream, IdGlobal,
  417. IdMessageCoderMIME, // Here so the 'MIME' in create will always suceed
  418. IdCharSets, IdGlobalProtocols, IdMessageCoder, IdResourceStringsProtocols,
  419. IdMessageClient, IdAttachmentFile,
  420. SysUtils;
  421. const
  422. cPriorityStrs: array[TIdMessagePriority] of string = ('urgent', 'urgent', 'normal', 'non-urgent', 'non-urgent');
  423. cImportanceStrs: array[TIdMessagePriority] of string = ('high', 'high', 'normal', 'low', 'low');
  424. { TIdMIMEBoundary }
  425. procedure TIdMIMEBoundary.Clear;
  426. begin
  427. FBoundaryList.Clear;
  428. FParentPartList.Clear;
  429. end;
  430. function TIdMIMEBoundary.Count: integer;
  431. begin
  432. Result := FBoundaryList.Count;
  433. end;
  434. constructor TIdMIMEBoundary.Create;
  435. begin
  436. inherited;
  437. FBoundaryList := TStringList.Create;
  438. FParentPartList := TStringList.Create;
  439. end;
  440. destructor TIdMIMEBoundary.Destroy;
  441. begin
  442. FBoundaryList.Free;
  443. FParentPartList.Free;
  444. inherited;
  445. end;
  446. function TIdMIMEBoundary.GetBoundary: string;
  447. begin
  448. if FBoundaryList.Count > 0 then begin
  449. Result := FBoundaryList.Strings[0];
  450. end else begin
  451. Result := '';
  452. end;
  453. end;
  454. function TIdMIMEBoundary.GetParentPart: integer;
  455. begin
  456. if FParentPartList.Count > 0 then begin
  457. Result := IndyStrToInt(FParentPartList.Strings[0]);
  458. end else begin
  459. Result := -1;
  460. end;
  461. end;
  462. procedure TIdMIMEBoundary.Pop;
  463. begin
  464. if FBoundaryList.Count > 0 then begin
  465. FBoundaryList.Delete(0);
  466. end;
  467. if FParentPartList.Count > 0 then begin
  468. FParentPartList.Delete(0);
  469. end;
  470. end;
  471. procedure TIdMIMEBoundary.Push(ABoundary: string; AParentPart: integer);
  472. begin
  473. {CC: Changed implementation to a simple stack}
  474. FBoundaryList.Insert(0, ABoundary);
  475. FParentPartList.Insert(0, IntToStr(AParentPart));
  476. end;
  477. { TIdMessage }
  478. constructor TIdMessage.Create(AOwner: TComponent);
  479. begin
  480. inherited Create(AOwner);
  481. FBody := TStringList.Create;
  482. TStringList(FBody).Duplicates := dupAccept;
  483. FRecipients := TIdEmailAddressList.Create(Self);
  484. FBccList := TIdEmailAddressList.Create(Self);
  485. FCcList := TIdEmailAddressList.Create(Self);
  486. FMessageParts := TIdMessageParts.Create(Self);
  487. FNewsGroups := TStringList.Create;
  488. FHeaders := TIdHeaderList.Create(QuoteRFC822);
  489. FFromList := TIdEmailAddressList.Create(Self);
  490. FReplyTo := TIdEmailAddressList.Create(Self);
  491. FSender := TIdEmailAddressItem.Create;
  492. FExtraHeaders := TIdHeaderList.Create(QuoteRFC822);
  493. FReceiptRecipient := TIdEmailAddressItem.Create;
  494. NoDecode := ID_MSG_NODECODE;
  495. FMIMEBoundary := TIdMIMEBoundary.Create;
  496. FLastGeneratedHeaders := TIdHeaderList.Create(QuoteRFC822);
  497. Clear;
  498. FEncoding := meDefault;
  499. end;
  500. destructor TIdMessage.Destroy;
  501. begin
  502. FBody.Free;
  503. FRecipients.Free;
  504. FBccList.Free;
  505. FCcList.Free;
  506. FMessageParts.Free;
  507. FNewsGroups.Free;
  508. FHeaders.Free;
  509. FExtraHeaders.Free;
  510. FFromList.Free;
  511. FReplyTo.Free;
  512. FSender.Free;
  513. FReceiptRecipient.Free;
  514. FMIMEBoundary.Free;
  515. FLastGeneratedHeaders.Free;
  516. inherited Destroy;
  517. end;
  518. procedure TIdMessage.AddHeader(const AValue: string);
  519. begin
  520. FHeaders.Add(AValue);
  521. end;
  522. procedure TIdMessage.Clear;
  523. begin
  524. ClearHeader;
  525. ClearBody;
  526. end;
  527. procedure TIdMessage.ClearBody;
  528. begin
  529. MessageParts.Clear;
  530. Body.Clear;
  531. end;
  532. procedure TIdMessage.ClearHeader;
  533. begin
  534. CcList.Clear;
  535. BccList.Clear;
  536. Date := 0;
  537. FromList.Clear;
  538. NewsGroups.Clear;
  539. Organization := '';
  540. References := '';
  541. ReplyTo.Clear;
  542. Subject := '';
  543. Recipients.Clear;
  544. Priority := ID_MSG_PRIORITY;
  545. ReceiptRecipient.Text := '';
  546. FContentType := '';
  547. FCharSet := '';
  548. ContentTransferEncoding := '';
  549. ContentDisposition := '';
  550. FSender.Text := '';
  551. Headers.Clear;
  552. ExtraHeaders.Clear;
  553. FMIMEBoundary.Clear;
  554. // UseNowForDate := ID_MSG_USENOWFORDATE;
  555. Flags := [];
  556. MsgId := '';
  557. UID := '';
  558. FLastGeneratedHeaders.Clear;
  559. FEncoding := meDefault; {CC3: Changed initial encoding from meMIME to meDefault}
  560. FConvertPreamble := True; {By default, in MIME, we convert the preamble text to the 1st TIdText part}
  561. FSavingToFile := False; {Only set True by SaveToFile}
  562. FIsMsgSinglePartMime := False;
  563. end;
  564. function TIdMessage.IsBodyEmpty: Boolean;
  565. //Determine if there really is anything in the body
  566. var
  567. LN: integer;
  568. LOrd: integer;
  569. begin
  570. Result := False;
  571. for LN := 1 to Length(Body.Text) do begin
  572. LOrd := Ord(Body.Text[LN]);
  573. if ((LOrd <> 13) and (LOrd <> 10) and (LOrd <> 9) and (LOrd <> 32)) then begin
  574. Exit;
  575. end;
  576. end;
  577. Result := True;
  578. end;
  579. procedure TIdMessage.GenerateHeader;
  580. var
  581. ISOCharset: string;
  582. HeaderEncoding: Char;
  583. LN: Integer;
  584. LEncoding, LCharSet, LMIMEBoundary: string;
  585. LDate: TDateTime;
  586. LReceiptRecipient: string;
  587. begin
  588. MessageParts.CountParts;
  589. {CC2: If the encoding is meDefault, the user wants us to pick an encoding mechanism:}
  590. if Encoding = meDefault then begin
  591. if MessageParts.Count = 0 then begin
  592. {If there are no attachments, we want the simplest type, just the headers
  593. followed by the message body: mePlainText does this for us}
  594. Encoding := mePlainText;
  595. end else begin
  596. {If there are any attachments, default to MIME...}
  597. Encoding := meMIME;
  598. end;
  599. end;
  600. for LN := 0 to MessageParts.Count-1 do begin
  601. {Change any encodings we don't know to base64 for MIME and UUE for PlainText...}
  602. LEncoding := ExtractHeaderItem(MessageParts[LN].ContentTransfer);
  603. if LEncoding <> '' then begin
  604. if Encoding = meMIME then begin
  605. if PosInStrArray(LEncoding, ['7bit', '8bit', 'binary', 'base64', 'quoted-printable', 'binhex40'], False) = -1 then begin {do not localize}
  606. MessageParts[LN].ContentTransfer := 'base64'; {do not localize}
  607. end;
  608. end
  609. else if PosInStrArray(LEncoding, ['UUE', 'XXE'], False) = -1 then begin {do not localize}
  610. //mePlainText
  611. MessageParts[LN].ContentTransfer := 'UUE'; {do not localize}
  612. end;
  613. end;
  614. end;
  615. {RLebeau: should we validate the TIdMessage.ContentTransferEncoding property as well?}
  616. {CC2: We dont support attachments in an encoded body.
  617. Change it to a supported combination...}
  618. if MessageParts.Count > 0 then begin
  619. if (ContentTransferEncoding <> '') and
  620. (not IsHeaderValue(ContentTransferEncoding, ['7bit', '8bit', 'binary'])) then begin {do not localize}
  621. ContentTransferEncoding := '';
  622. end;
  623. end;
  624. if Encoding = meMIME then begin
  625. //HH: Generate Boundary here so we know it in the headers and body
  626. //######### SET UP THE BOUNDARY STACK ########
  627. //RLebeau: Moved this logic up from SendBody to here, where it fits better...
  628. MIMEBoundary.Clear;
  629. LMIMEBoundary := TIdMIMEBoundaryStrings.GenerateBoundary;
  630. MIMEBoundary.Push(LMIMEBoundary, -1); //-1 is "top level"
  631. //CC: Moved this logic up from SendBody to here, where it fits better...
  632. if ContentType = '' then begin
  633. //User has omitted ContentType. We have to guess here, it is impossible
  634. //to determine without having procesed the parts.
  635. //See if it is multipart/alternative...
  636. if MessageParts.TextPartCount > 1 then begin
  637. if MessageParts.AttachmentCount > 0 then begin
  638. ContentType := 'multipart/mixed'; {do not localize}
  639. end else begin
  640. ContentType := 'multipart/alternative'; {do not localize}
  641. end;
  642. end else
  643. begin
  644. //Just one (or 0?) text part.
  645. if MessageParts.AttachmentCount > 0 then begin
  646. ContentType := 'multipart/mixed'; {do not localize}
  647. end else begin
  648. ContentType := 'text/plain'; {do not localize}
  649. end;
  650. end;
  651. end;
  652. TIdMessageEncoderInfo(MessageParts.MessageEncoderInfo).InitializeHeaders(Self);
  653. end;
  654. InitializeISO(HeaderEncoding, ISOCharSet);
  655. FLastGeneratedHeaders.Assign(FHeaders);
  656. FIsMsgSinglePartMime := (Encoding = meMIME) and (MessageParts.Count = 1) and IsBodyEmpty;
  657. {CC: If From has no Name field, use the Address field as the Name field by setting last param to True (for SA)...}
  658. FLastGeneratedHeaders.Values['From'] := EncodeAddress(FromList, HeaderEncoding, ISOCharSet, True); {do not localize}
  659. FLastGeneratedHeaders.Values['Subject'] := EncodeHeader(Subject, '', HeaderEncoding, ISOCharSet); {do not localize}
  660. FLastGeneratedHeaders.Values['To'] := EncodeAddress(Recipients, HeaderEncoding, ISOCharSet); {do not localize}
  661. FLastGeneratedHeaders.Values['Cc'] := EncodeAddress(CCList, HeaderEncoding, ISOCharSet); {do not localize}
  662. {CC: SaveToFile sets FSavingToFile to True so that BCC names are saved
  663. when saving to file and omitted otherwise (as required by SMTP)...}
  664. if not FSavingToFile then begin
  665. FLastGeneratedHeaders.Values['Bcc'] := ''; {do not localize}
  666. end else begin
  667. FLastGeneratedHeaders.Values['Bcc'] := EncodeAddress(BCCList, HeaderEncoding, ISOCharSet); {do not localize}
  668. end;
  669. FLastGeneratedHeaders.Values['Newsgroups'] := NewsGroups.CommaText; {do not localize}
  670. if Encoding = meMIME then
  671. begin
  672. if IsMsgSinglePartMime then begin
  673. {This is a single-part MIME: the part may be a text part or an attachment.
  674. The relevant headers need to be taken from MessageParts[0]. The problem,
  675. however, is that we have not yet processed MessageParts[0] yet, so we do
  676. not have its properties or header content properly set up. So we will
  677. let the processing of MessageParts[0] append its headers to the message
  678. headers, i.e. DON'T generate Content-Type or Content-Transfer-Encoding
  679. headers here.}
  680. FLastGeneratedHeaders.Values['MIME-Version'] := '1.0'; {do not localize}
  681. {RLebeau: need to wipe out the following headers if they were present,
  682. otherwise MessageParts[0] will duplicate them instead of replacing them.
  683. This is because LastGeneratedHeaders is sent before MessageParts[0] is
  684. processed.}
  685. FLastGeneratedHeaders.Values['Content-Type'] := '';
  686. FLastGeneratedHeaders.Values['Content-Transfer-Encoding'] := '';
  687. FLastGeneratedHeaders.Values['Content-Disposition'] := '';
  688. end else begin
  689. if FContentType <> '' then begin
  690. LCharSet := FCharSet;
  691. if (LCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  692. LCharSet := 'us-ascii'; {do not localize}
  693. end;
  694. FLastGeneratedHeaders.Values['Content-Type'] := FContentType; {do not localize}
  695. FLastGeneratedHeaders.Params['Content-Type', 'charset'] := LCharSet; {do not localize}
  696. if (MessageParts.Count > 0) and (LMIMEBoundary <> '') then begin
  697. FLastGeneratedHeaders.Params['Content-Type', 'boundary'] := LMIMEBoundary; {do not localize}
  698. end;
  699. end;
  700. {CC2: We may have MIME with no parts if ConvertPreamble is True}
  701. FLastGeneratedHeaders.Values['MIME-Version'] := '1.0'; {do not localize}
  702. FLastGeneratedHeaders.Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
  703. end;
  704. end else begin
  705. //CC: non-MIME can have ContentTransferEncoding of base64, quoted-printable...
  706. LCharSet := FCharSet;
  707. if (LCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  708. LCharSet := 'us-ascii'; {do not localize}
  709. end;
  710. FLastGeneratedHeaders.Values['Content-Type'] := FContentType; {do not localize}
  711. FLastGeneratedHeaders.Params['Content-Type', 'charset'] := LCharSet; {do not localize}
  712. FLastGeneratedHeaders.Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
  713. end;
  714. FLastGeneratedHeaders.Values['Sender'] := EncodeAddressItem(Sender, HeaderEncoding, ISOCharSet); {do not localize}
  715. FLastGeneratedHeaders.Values['Reply-To'] := EncodeAddress(ReplyTo, HeaderEncoding, ISOCharSet); {do not localize}
  716. FLastGeneratedHeaders.Values['Organization'] := EncodeHeader(Organization, '', HeaderEncoding, ISOCharSet); {do not localize}
  717. LReceiptRecipient := EncodeAddressItem(ReceiptRecipient, HeaderEncoding, ISOCharSet);
  718. FLastGeneratedHeaders.Values['Disposition-Notification-To'] := LReceiptRecipient; {do not localize}
  719. FLastGeneratedHeaders.Values['Return-Receipt-To'] := LReceiptRecipient; {do not localize}
  720. FLastGeneratedHeaders.Values['References'] := References; {do not localize}
  721. if UseNowForDate then begin
  722. LDate := Now;
  723. end else begin
  724. LDate := Self.Date;
  725. end;
  726. FLastGeneratedHeaders.Values['Date'] := LocalDateTimeToGMT(LDate); {do not localize}
  727. // S.G. 27/1/2003: Only issue X-Priority header if priority <> mpNormal (for stoopid spam filters)
  728. // RLebeau 2/2/2014: add a new Importance property
  729. if Priority <> mpNormal then begin
  730. FLastGeneratedHeaders.Values['Priority'] := cPriorityStrs[Priority]; {do not localize}
  731. FLastGeneratedHeaders.Values['X-Priority'] := IntToStr(Ord(Priority) + 1); {do not localize}
  732. FLastGeneratedHeaders.Values['Importance'] := cImportanceStrs[Priority]; {do not localize}
  733. end else begin
  734. FLastGeneratedHeaders.Values['Priority'] := ''; {do not localize}
  735. FLastGeneratedHeaders.Values['X-Priority'] := ''; {do not localize}
  736. FLastGeneratedHeaders.Values['Importance'] := ''; {do not localize}
  737. end;
  738. FLastGeneratedHeaders.Values['Message-ID'] := MsgId;
  739. // RLebeau 9/12/2016: no longer auto-generating In-Reply-To based on
  740. // Message-ID. Many email servers will reject an outgoing email that
  741. // does not have a client-assigned Message-ID, and this method does not
  742. // know whether this email is a new message or a response to another
  743. // email when generating headers. If the calling app wants to send
  744. // In-Reply-To, it will just have to populate that header like any other.
  745. FLastGeneratedHeaders.Values['In-Reply-To'] := InReplyTo; {do not localize}
  746. // Add extra headers created by UA - allows duplicates
  747. if (FExtraHeaders.Count > 0) then begin
  748. FLastGeneratedHeaders.AddStrings(FExtraHeaders);
  749. end;
  750. {TODO: Generate Message-ID if at all possible to pacify SA. Do this after FExtraHeaders
  751. added in case there is a message-ID present as an extra header.}
  752. {
  753. if FLastGeneratedHeaders.Values['Message-ID'] = '' then begin //do not localize
  754. FLastGeneratedHeaders.Values['Message-ID'] := '<' + IntToStr(Abs( CurrentProcessId )) + '.' + IntToStr(Abs( GetClockValue )) + '@' + GStack.HostName + '>'; //do not localize
  755. end;
  756. }
  757. end;
  758. procedure TIdMessage.ProcessHeaders;
  759. var
  760. LBoundary: string;
  761. LMIMEVersion: string;
  762. LTemp: string;
  763. // Some mailers send priority as text, number or combination of both
  764. function GetMsgPriority(APriority: string): TIdMessagePriority;
  765. var
  766. s: string;
  767. Num: integer;
  768. begin
  769. APriority := LowerCase(APriority);
  770. // TODO: use PostInStrArray() instead of IndyPos()
  771. // This is for Pegasus / X-MSMail-Priority / Importance headers
  772. if (IndyPos('non-urgent', APriority) <> 0) or {do not localize}
  773. (IndyPos('low', APriority) <> 0) then {do not localize}
  774. begin
  775. Result := mpLowest;
  776. // Although a matter of choice, IMO mpLowest is better choice than mpLow,
  777. // various examples on the net also use 1 as urgent and 5 as non-urgent
  778. end
  779. else if (IndyPos('urgent', APriority) <> 0) or {do not localize}
  780. (IndyPos('high', APriority) <> 0) then {do not localize}
  781. begin
  782. Result := mpHighest;
  783. // Although a matter of choice, IMO mpHighest is better choice than mpHigh,
  784. // various examples on the net also use 1 as urgent and 5 as non-urgent
  785. end else
  786. begin
  787. s := Trim(APriority);
  788. Num := IndyStrToInt(Fetch(s, ' '), 3); {do not localize}
  789. if (Num < 1) or (Num > 5) then begin
  790. Num := 3;
  791. end;
  792. Result := TIdMessagePriority(Num - 1);
  793. end;
  794. end;
  795. begin
  796. // RLebeau: per RFC 2045 Section 5.2:
  797. //
  798. // Default RFC 822 messages without a MIME Content-Type header are taken
  799. // by this protocol to be plain text in the US-ASCII character set,
  800. // which can be explicitly specified as:
  801. //
  802. // Content-type: text/plain; charset=us-ascii
  803. //
  804. // This default is assumed if no Content-Type header field is specified.
  805. // It is also recommend that this default be assumed when a
  806. // syntactically invalid Content-Type header field is encountered. In
  807. // the presence of a MIME-Version header field and the absence of any
  808. // Content-Type header field, a receiving User Agent can also assume
  809. // that plain US-ASCII text was the sender's intent. Plain US-ASCII
  810. // text may still be assumed in the absence of a MIME-Version or the
  811. // presence of an syntactically invalid Content-Type header field, but
  812. // the sender's intent might have been otherwise.
  813. FContentType := Headers.Values['Content-Type']; {do not localize}
  814. if FContentType = '' then begin
  815. FContentType := 'text/plain'; {do not localize}
  816. FCharSet := 'us-ascii'; {do not localize}
  817. end else begin
  818. FContentType := RemoveHeaderEntry(FContentType, 'charset', FCharSet, QuoteMIME); {do not localize}
  819. if (FCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  820. FCharSet := 'us-ascii'; {do not localize}
  821. end;
  822. end;
  823. ContentTransferEncoding := Headers.Values['Content-Transfer-Encoding']; {do not localize}
  824. ContentDisposition := Headers.Values['Content-Disposition']; {do not localize}
  825. Subject := DecodeHeader(Headers.Values['Subject']); {do not localize}
  826. DecodeAddresses(Headers.Values['From'], FromList); {do not localize}
  827. MsgId := Headers.Values['Message-Id']; {do not localize}
  828. CommaSeparatedToStringList(Newsgroups, Headers.Values['Newsgroups']); {do not localize}
  829. DecodeAddresses(Headers.Values['To'], Recipients); {do not localize}
  830. DecodeAddresses(Headers.Values['Cc'], CCList); {do not localize}
  831. {CC2: Added support for BCCList...}
  832. DecodeAddresses(Headers.Values['Bcc'], BCCList); {do not localize}
  833. Organization := Headers.Values['Organization']; {do not localize}
  834. InReplyTo := Headers.Values['In-Reply-To']; {do not localize}
  835. LTemp := Headers.Values['Disposition-Notification-To']; {do not localize}
  836. if LTemp = '' then begin
  837. LTemp := Headers.Values['Return-Receipt-To']; {do not localize}
  838. end;
  839. ReceiptRecipient.Text := LTemp;
  840. References := Headers.Values['References']; {do not localize}
  841. DecodeAddresses(Headers.Values['Reply-To'], ReplyTo); {do not localize}
  842. Date := GMTToLocalDateTime(Headers.Values['Date']); {do not localize}
  843. Sender.Text := Headers.Values['Sender']; {do not localize}
  844. // RLebeau 2/2/2014: add a new Importance property
  845. // Examine X-Priority first - to get better resolution if possible and because it is the most common
  846. LTemp := Headers.Values['X-Priority']; {do not localize}
  847. if LTemp = '' then begin
  848. // Which header should be here is matter of a bit of research, it might be that Importance might be checked first
  849. LTemp := Headers.Values['Priority']; {do not localize}
  850. if LTemp = '' then begin
  851. // Check Importance or Priority
  852. LTemp := Headers.Values['Importance']; {do not localize}
  853. if LTemp = '' then begin
  854. // This is the least common header (or at least should be) so can be checked last
  855. LTemp := Headers.Values['X-MSMail-Priority']; {do not localize}
  856. end;
  857. end;
  858. end;
  859. if LTemp <> '' then begin
  860. Priority := GetMsgPriority(LTemp);
  861. else begin
  862. Priority := mpNormal;
  863. end;
  864. {Note that the following code ensures MIMEBoundary.Count is 0 for single-part MIME messages...}
  865. FContentType := RemoveHeaderEntry(FContentType, 'boundary', LBoundary, QuoteMIME); {do not localize}
  866. if LBoundary <> '' then begin
  867. MIMEBoundary.Push(LBoundary, -1);
  868. end;
  869. {CC2: Set MESSAGE_LEVEL "encoding" (really the format or layout)}
  870. LMIMEVersion := Headers.Values['MIME-Version']; {do not localize}
  871. if LMIMEVersion = '' then begin
  872. Encoding := mePlainText;
  873. end else begin
  874. // TODO: this should be true if a MIME boundary is present.
  875. // The MIME version is optional...
  876. Encoding := meMIME;
  877. end;
  878. end;
  879. procedure TIdMessage.SetBccList(const AValue: TIdEmailAddressList);
  880. begin
  881. FBccList.Assign(AValue);
  882. end;
  883. procedure TIdMessage.SetBody(const AValue: TStrings);
  884. begin
  885. FBody.Assign(AValue);
  886. end;
  887. procedure TIdMessage.SetCCList(const AValue: TIdEmailAddressList);
  888. begin
  889. FCcList.Assign(AValue);
  890. end;
  891. procedure TIdMessage.SetContentType(const AValue: String);
  892. var
  893. LCharSet: String;
  894. begin
  895. // RLebeau: per RFC 2045 Section 5.2:
  896. //
  897. // Default RFC 822 messages without a MIME Content-Type header are taken
  898. // by this protocol to be plain text in the US-ASCII character set,
  899. // which can be explicitly specified as:
  900. //
  901. // Content-type: text/plain; charset=us-ascii
  902. //
  903. // This default is assumed if no Content-Type header field is specified.
  904. // It is also recommend that this default be assumed when a
  905. // syntactically invalid Content-Type header field is encountered. In
  906. // the presence of a MIME-Version header field and the absence of any
  907. // Content-Type header field, a receiving User Agent can also assume
  908. // that plain US-ASCII text was the sender's intent. Plain US-ASCII
  909. // text may still be assumed in the absence of a MIME-Version or the
  910. // presence of an syntactically invalid Content-Type header field, but
  911. // the sender's intent might have been otherwise.
  912. if AValue <> '' then
  913. begin
  914. FContentType := RemoveHeaderEntry(AValue, 'charset', LCharSet, QuoteMIME); {do not localize}
  915. {RLebeau: the ContentType property is streamed after the CharSet property,
  916. so do not overwrite it during streaming}
  917. if csReading in ComponentState then begin
  918. Exit;
  919. end;
  920. if (LCharSet = '') and (FCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  921. LCharSet := 'us-ascii'; {do not localize}
  922. end;
  923. {RLebeau: override the current CharSet only if the header specifies a new value}
  924. if LCharSet <> '' then begin
  925. FCharSet := LCharSet;
  926. end;
  927. end else
  928. begin
  929. FContentType := 'text/plain'; {do not localize}
  930. {RLebeau: the ContentType property is streamed after the CharSet property,
  931. so do not overwrite it during streaming}
  932. if not (csReading in ComponentState) then begin
  933. FCharSet := 'us-ascii'; {do not localize}
  934. end;
  935. end;
  936. end;
  937. procedure TIdMessage.SetExtraHeaders(const AValue: TIdHeaderList);
  938. begin
  939. FExtraHeaders.Assign(AValue);
  940. end;
  941. procedure TIdMessage.SetFrom(const AValue: TIdEmailAddressItem);
  942. begin
  943. GetFrom.Assign(AValue);
  944. end;
  945. function TIdMessage.GetFrom: TIdEmailAddressItem;
  946. begin
  947. if FFromList.Count = 0 then begin
  948. FFromList.Add;
  949. end;
  950. Result := FFromList[0];
  951. end;
  952. procedure TIdMessage.SetFromList(const AValue: TIdEmailAddressList);
  953. begin
  954. FFromList.Assign(AValue);
  955. end;
  956. procedure TIdMessage.SetHeaders(const AValue: TIdHeaderList);
  957. begin
  958. FHeaders.Assign(AValue);
  959. end;
  960. procedure TIdMessage.SetNewsGroups(const AValue: TStrings);
  961. begin
  962. FNewsgroups.Assign(AValue);
  963. end;
  964. procedure TIdMessage.SetReceiptRecipient(const AValue: TIdEmailAddressItem);
  965. begin
  966. FReceiptRecipient.Assign(AValue);
  967. end;
  968. procedure TIdMessage.SetRecipients(const AValue: TIdEmailAddressList);
  969. begin
  970. FRecipients.Assign(AValue);
  971. end;
  972. procedure TIdMessage.SetReplyTo(const AValue: TIdEmailAddressList);
  973. begin
  974. FReplyTo.Assign(AValue);
  975. end;
  976. procedure TIdMessage.SetSender(const AValue: TIdEmailAddressItem);
  977. begin
  978. FSender.Assign(AValue);
  979. end;
  980. function TIdMessage.GetUseNowForDate: Boolean;
  981. begin
  982. Result := (FDate = 0);
  983. end;
  984. procedure TIdMessage.SetUseNowForDate(const AValue: Boolean);
  985. begin
  986. if GetUseNowForDate <> AValue then begin
  987. if AValue then begin
  988. FDate := 0;
  989. end else begin
  990. FDate := Now;
  991. end;
  992. end;
  993. end;
  994. procedure TIdMessage.SetAttachmentEncoding(const AValue: string);
  995. begin
  996. MessageParts.AttachmentEncoding := AValue;
  997. end;
  998. function TIdMessage.GetAttachmentEncoding: string;
  999. begin
  1000. Result := MessageParts.AttachmentEncoding;
  1001. end;
  1002. procedure TIdMessage.SetEncoding(const AValue: TIdMessageEncoding);
  1003. begin
  1004. FEncoding := AValue;
  1005. if AValue = meMIME then begin
  1006. AttachmentEncoding := 'MIME'; {do not localize}
  1007. end else begin
  1008. //Default to UUE for mePlainText, user can override to XXE by calling
  1009. //TIdMessage.AttachmentEncoding := 'XXE';
  1010. AttachmentEncoding := 'UUE'; {do not localize}
  1011. end;
  1012. end;
  1013. procedure TIdMessage.LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False;
  1014. const AUseDotTransparency: Boolean = True);
  1015. var
  1016. LStream: TIdReadFileExclusiveStream;
  1017. begin
  1018. try
  1019. LStream := TIdReadFileExclusiveStream.Create(AFilename);
  1020. except
  1021. IndyRaiseOuterException(EIdMessageCannotLoad.CreateFmt(RSIdMessageCannotLoad, [AFilename]));
  1022. end;
  1023. try
  1024. LoadFromStream(LStream, AHeadersOnly, AUseDotTransparency);
  1025. finally
  1026. LStream.Free;
  1027. end;
  1028. end;
  1029. procedure TIdMessage.LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False;
  1030. const AUseDotTransparency: Boolean = True);
  1031. var
  1032. LMsgClient: TIdMessageClient;
  1033. LIOHandler: TIdIOHandlerStreamMsg;
  1034. begin
  1035. // clear message properties, headers before loading
  1036. Clear;
  1037. LMsgClient := TIdMessageClient.Create;
  1038. try
  1039. // TODO: add AUsesDotTransparency parameter to ProcessMessage()...
  1040. //LMsgClient.ProcessMessage(Self, AStream, AHeadersOnly, AUsesDotTransparency);
  1041. LIOHandler := TIdIOHandlerStreamMsg.Create(nil, AStream);
  1042. try
  1043. LIOHandler.FreeStreams := False;
  1044. LIOHandler.EscapeLines := not AUsesDotTransparency; // <-- this is the key!
  1045. LMsgClient.IOHandler := LIOHandler;
  1046. try
  1047. LIOHandler.Open;
  1048. LMsgClient.ProcessMessage(Self, AHeaderOnly);
  1049. finally
  1050. LMsgClient.IOHandler := nil;
  1051. end;
  1052. finally
  1053. LIOHandler.Free;
  1054. end;
  1055. finally
  1056. LMsgClient.Free;
  1057. end;
  1058. end;
  1059. procedure TIdMessage.SaveToFile(const AFileName: string; const AHeadersOnly: Boolean = False;
  1060. const AUseDotTransparency: Boolean = True);
  1061. var
  1062. LStream : TFileStream;
  1063. begin
  1064. LStream := TIdFileCreateStream.Create(AFileName);
  1065. try
  1066. FSavingToFile := True;
  1067. try
  1068. SaveToStream(LStream, AHeadersOnly, AUseDotTransparency);
  1069. finally
  1070. FSavingToFile := False;
  1071. end;
  1072. finally
  1073. LStream.Free;
  1074. end;
  1075. end;
  1076. procedure TIdMessage.SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False;
  1077. const AUseDotTransparency: Boolean = True);
  1078. var
  1079. LMsgClient: TIdMessageClient;
  1080. LIOHandler: TIdIOHandlerStream;
  1081. begin
  1082. LMsgClient := TIdMessageClient.Create(nil);
  1083. try
  1084. // TODO: add AUsesDotTransparency parameter to ProcessMessage()...
  1085. //LMsgClient.SendMsg(Self, AHeadersOnly, AUsesDotTransparency);
  1086. LIOHandler := TIdIOHandlerStreamMsg.Create(nil, nil, AStream);
  1087. try
  1088. LIOHandler.FreeStreams := False;
  1089. LIOHandler.UnescapeLines := not AUseDotTransparency; // <-- this is the key!
  1090. LMsgClient.IOHandler := LIOHandler;
  1091. try
  1092. LMsgClient.SendMsg(Self, AHeadersOnly);
  1093. // add the end of message marker when body is included
  1094. if (not AHeadersOnly) and AUseDotTransparency then begin
  1095. LMsgClient.IOHandler.WriteLn('.'); {do not localize}
  1096. end;
  1097. finally
  1098. LMsgClient.IOHandler := nil;
  1099. end;
  1100. finally
  1101. LIOHandler.Free;
  1102. end;
  1103. finally
  1104. LMsgClient.Free;
  1105. end;
  1106. end;
  1107. procedure TIdMessage.DoInitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
  1108. begin
  1109. if Assigned(FOnInitializeISO) then begin
  1110. FOnInitializeISO(VHeaderEncoding, VCharSet);//APR
  1111. end;
  1112. end;
  1113. procedure TIdMessage.InitializeISO(var VHeaderEncoding: Char; var VCharSet: String);
  1114. var
  1115. LDefCharset: TIdCharSet;
  1116. begin
  1117. // it's not clear when FHeaderEncoding should be Q not B.
  1118. // Comments welcome on atozedsoftware.indy.general
  1119. LDefCharset := IdGetDefaultCharSet;
  1120. case LDefCharset of
  1121. idcs_ISO_8859_1:
  1122. begin
  1123. VHeaderEncoding := 'Q'; { quoted-printable } {Do not Localize}
  1124. VCharSet := IdCharsetNames[LDefCharset];
  1125. end;
  1126. idcs_UNICODE_1_1:
  1127. begin
  1128. VHeaderEncoding := 'B'; { base64 } {Do not Localize}
  1129. VCharSet := IdCharsetNames[idcs_UTF_8];
  1130. end;
  1131. else
  1132. begin
  1133. VHeaderEncoding := 'B'; { base64 } {Do not Localize}
  1134. VCharSet := IdCharsetNames[LDefCharset];
  1135. end;
  1136. end;
  1137. DoInitializeISO(VHeaderEncoding, VCharSet);
  1138. end;
  1139. procedure TIdMessage.DoCreateAttachment(const AHeaders: TStrings;
  1140. var VAttachment: TIdAttachment);
  1141. begin
  1142. VAttachment := nil;
  1143. if Assigned(FOnCreateAttachment) then begin
  1144. FOnCreateAttachment(Self, AHeaders, VAttachment);
  1145. end;
  1146. if VAttachment = nil then begin
  1147. VAttachment := TIdAttachmentFile.Create(MessageParts);
  1148. end;
  1149. end;
  1150. function TIdMessage.IsBodyEncodingRequired: Boolean;
  1151. var
  1152. i,j: Integer;
  1153. S: String;
  1154. begin
  1155. Result := False;//7bit
  1156. for i:= 0 to FBody.Count - 1 do begin
  1157. S := FBody[i];
  1158. for j := 1 to Length(S) do begin
  1159. if S[j] > #127 then begin
  1160. Result := True;
  1161. Exit;
  1162. end;
  1163. end;
  1164. end;
  1165. end;//
  1166. function TIdMessage.GetInReplyTo: String;
  1167. begin
  1168. Result := EnsureMsgIDBrackets(FInReplyTo);
  1169. end;
  1170. procedure TIdMessage.SetInReplyTo(const AValue: String);
  1171. begin
  1172. FInReplyTo := EnsureMsgIDBrackets(AValue);
  1173. end;
  1174. // TODO: add this?
  1175. {
  1176. procedure TIdMessage.GetMsgID: String;
  1177. begin
  1178. Result := EnsureMsgIDBrackets(FMsgId);
  1179. end;
  1180. }
  1181. procedure TIdMessage.SetMsgID(const AValue: String);
  1182. begin
  1183. FMsgId := EnsureMsgIDBrackets(AValue);
  1184. end;
  1185. procedure TIdMessage.SetAttachmentTempDirectory(const Value: string);
  1186. begin
  1187. if Value <> AttachmentTempDirectory then begin
  1188. FAttachmentTempDirectory := IndyExcludeTrailingPathDelimiter(Value);
  1189. end;
  1190. end;
  1191. end.