IdMessage.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351
  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. procedure InitComponent; override;
  337. public
  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);
  348. procedure LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False);
  349. procedure ProcessHeaders; virtual;
  350. procedure SaveToFile(const AFileName : string; const AHeadersOnly: Boolean = False);
  351. procedure SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False);
  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. {$IFDEF DOTNET}
  417. {$IFDEF USE_INLINE}
  418. System.IO,
  419. {$ENDIF}
  420. {$ENDIF}
  421. IdIOHandlerStream, IdGlobal,
  422. IdMessageCoderMIME, // Here so the 'MIME' in create will always suceed
  423. IdCharSets, IdGlobalProtocols, IdMessageCoder, IdResourceStringsProtocols,
  424. IdMessageClient, IdAttachmentFile,
  425. SysUtils;
  426. const
  427. cPriorityStrs: array[TIdMessagePriority] of string = ('urgent', 'urgent', 'normal', 'non-urgent', 'non-urgent');
  428. cImportanceStrs: array[TIdMessagePriority] of string = ('high', 'high', 'normal', 'low', 'low');
  429. { TIdMIMEBoundary }
  430. procedure TIdMIMEBoundary.Clear;
  431. begin
  432. FBoundaryList.Clear;
  433. FParentPartList.Clear;
  434. end;
  435. function TIdMIMEBoundary.Count: integer;
  436. begin
  437. Result := FBoundaryList.Count;
  438. end;
  439. constructor TIdMIMEBoundary.Create;
  440. begin
  441. inherited;
  442. FBoundaryList := TStringList.Create;
  443. FParentPartList := TStringList.Create;
  444. end;
  445. destructor TIdMIMEBoundary.Destroy;
  446. begin
  447. FreeAndNil(FBoundaryList);
  448. FreeAndNil(FParentPartList);
  449. inherited;
  450. end;
  451. function TIdMIMEBoundary.GetBoundary: string;
  452. begin
  453. if FBoundaryList.Count > 0 then begin
  454. Result := FBoundaryList.Strings[0];
  455. end else begin
  456. Result := '';
  457. end;
  458. end;
  459. function TIdMIMEBoundary.GetParentPart: integer;
  460. begin
  461. if FParentPartList.Count > 0 then begin
  462. Result := IndyStrToInt(FParentPartList.Strings[0]);
  463. end else begin
  464. Result := -1;
  465. end;
  466. end;
  467. procedure TIdMIMEBoundary.Pop;
  468. begin
  469. if FBoundaryList.Count > 0 then begin
  470. FBoundaryList.Delete(0);
  471. end;
  472. if FParentPartList.Count > 0 then begin
  473. FParentPartList.Delete(0);
  474. end;
  475. end;
  476. procedure TIdMIMEBoundary.Push(ABoundary: string; AParentPart: integer);
  477. begin
  478. {CC: Changed implementation to a simple stack}
  479. FBoundaryList.Insert(0, ABoundary);
  480. FParentPartList.Insert(0, IntToStr(AParentPart));
  481. end;
  482. { TIdMessage }
  483. procedure TIdMessage.AddHeader(const AValue: string);
  484. begin
  485. FHeaders.Add(AValue);
  486. end;
  487. procedure TIdMessage.Clear;
  488. begin
  489. ClearHeader;
  490. ClearBody;
  491. end;
  492. procedure TIdMessage.ClearBody;
  493. begin
  494. MessageParts.Clear;
  495. Body.Clear;
  496. end;
  497. procedure TIdMessage.ClearHeader;
  498. begin
  499. CcList.Clear;
  500. BccList.Clear;
  501. Date := 0;
  502. FromList.Clear;
  503. NewsGroups.Clear;
  504. Organization := '';
  505. References := '';
  506. ReplyTo.Clear;
  507. Subject := '';
  508. Recipients.Clear;
  509. Priority := ID_MSG_PRIORITY;
  510. ReceiptRecipient.Text := '';
  511. FContentType := '';
  512. FCharSet := '';
  513. ContentTransferEncoding := '';
  514. ContentDisposition := '';
  515. FSender.Text := '';
  516. Headers.Clear;
  517. ExtraHeaders.Clear;
  518. FMIMEBoundary.Clear;
  519. // UseNowForDate := ID_MSG_USENOWFORDATE;
  520. Flags := [];
  521. MsgId := '';
  522. UID := '';
  523. FLastGeneratedHeaders.Clear;
  524. FEncoding := meDefault; {CC3: Changed initial encoding from meMIME to meDefault}
  525. FConvertPreamble := True; {By default, in MIME, we convert the preamble text to the 1st TIdText part}
  526. FSavingToFile := False; {Only set True by SaveToFile}
  527. FIsMsgSinglePartMime := False;
  528. end;
  529. procedure TIdMessage.InitComponent;
  530. begin
  531. inherited;
  532. FBody := TStringList.Create;
  533. TStringList(FBody).Duplicates := dupAccept;
  534. FRecipients := TIdEmailAddressList.Create(Self);
  535. FBccList := TIdEmailAddressList.Create(Self);
  536. FCcList := TIdEmailAddressList.Create(Self);
  537. FMessageParts := TIdMessageParts.Create(Self);
  538. FNewsGroups := TStringList.Create;
  539. FHeaders := TIdHeaderList.Create(QuoteRFC822);
  540. FFromList := TIdEmailAddressList.Create(Self);
  541. FReplyTo := TIdEmailAddressList.Create(Self);
  542. FSender := TIdEmailAddressItem.Create;
  543. FExtraHeaders := TIdHeaderList.Create(QuoteRFC822);
  544. FReceiptRecipient := TIdEmailAddressItem.Create;
  545. NoDecode := ID_MSG_NODECODE;
  546. FMIMEBoundary := TIdMIMEBoundary.Create;
  547. FLastGeneratedHeaders := TIdHeaderList.Create(QuoteRFC822);
  548. Clear;
  549. FEncoding := meDefault;
  550. end;
  551. destructor TIdMessage.Destroy;
  552. begin
  553. FreeAndNil(FBody);
  554. FreeAndNil(FRecipients);
  555. FreeAndNil(FBccList);
  556. FreeAndNil(FCcList);
  557. FreeAndNil(FMessageParts);
  558. FreeAndNil(FNewsGroups);
  559. FreeAndNil(FHeaders);
  560. FreeAndNil(FExtraHeaders);
  561. FreeAndNil(FFromList);
  562. FreeAndNil(FReplyTo);
  563. FreeAndNil(FSender);
  564. FreeAndNil(FReceiptRecipient);
  565. FreeAndNil(FMIMEBoundary);
  566. FreeAndNil(FLastGeneratedHeaders);
  567. inherited Destroy;
  568. end;
  569. function TIdMessage.IsBodyEmpty: Boolean;
  570. //Determine if there really is anything in the body
  571. var
  572. LN: integer;
  573. LOrd: integer;
  574. begin
  575. Result := False;
  576. for LN := 1 to Length(Body.Text) do begin
  577. LOrd := Ord(Body.Text[LN]);
  578. if ((LOrd <> 13) and (LOrd <> 10) and (LOrd <> 9) and (LOrd <> 32)) then begin
  579. Exit;
  580. end;
  581. end;
  582. Result := True;
  583. end;
  584. procedure TIdMessage.GenerateHeader;
  585. var
  586. ISOCharset: string;
  587. HeaderEncoding: Char;
  588. LN: Integer;
  589. LEncoding, LCharSet, LMIMEBoundary: string;
  590. LDate: TDateTime;
  591. LReceiptRecipient: string;
  592. begin
  593. MessageParts.CountParts;
  594. {CC2: If the encoding is meDefault, the user wants us to pick an encoding mechanism:}
  595. if Encoding = meDefault then begin
  596. if MessageParts.Count = 0 then begin
  597. {If there are no attachments, we want the simplest type, just the headers
  598. followed by the message body: mePlainText does this for us}
  599. Encoding := mePlainText;
  600. end else begin
  601. {If there are any attachments, default to MIME...}
  602. Encoding := meMIME;
  603. end;
  604. end;
  605. for LN := 0 to MessageParts.Count-1 do begin
  606. {Change any encodings we don't know to base64 for MIME and UUE for PlainText...}
  607. LEncoding := ExtractHeaderItem(MessageParts[LN].ContentTransfer);
  608. if LEncoding <> '' then begin
  609. if Encoding = meMIME then begin
  610. if PosInStrArray(LEncoding, ['7bit', '8bit', 'binary', 'base64', 'quoted-printable', 'binhex40'], False) = -1 then begin {do not localize}
  611. MessageParts[LN].ContentTransfer := 'base64'; {do not localize}
  612. end;
  613. end
  614. else if PosInStrArray(LEncoding, ['UUE', 'XXE'], False) = -1 then begin {do not localize}
  615. //mePlainText
  616. MessageParts[LN].ContentTransfer := 'UUE'; {do not localize}
  617. end;
  618. end;
  619. end;
  620. {RLebeau: should we validate the TIdMessage.ContentTransferEncoding property as well?}
  621. {CC2: We dont support attachments in an encoded body.
  622. Change it to a supported combination...}
  623. if MessageParts.Count > 0 then begin
  624. if (ContentTransferEncoding <> '') and
  625. (not IsHeaderValue(ContentTransferEncoding, ['7bit', '8bit', 'binary'])) then begin {do not localize}
  626. ContentTransferEncoding := '';
  627. end;
  628. end;
  629. if Encoding = meMIME then begin
  630. //HH: Generate Boundary here so we know it in the headers and body
  631. //######### SET UP THE BOUNDARY STACK ########
  632. //RLebeau: Moved this logic up from SendBody to here, where it fits better...
  633. MIMEBoundary.Clear;
  634. LMIMEBoundary := TIdMIMEBoundaryStrings.GenerateBoundary;
  635. MIMEBoundary.Push(LMIMEBoundary, -1); //-1 is "top level"
  636. //CC: Moved this logic up from SendBody to here, where it fits better...
  637. if Length(ContentType) = 0 then begin
  638. //User has omitted ContentType. We have to guess here, it is impossible
  639. //to determine without having procesed the parts.
  640. //See if it is multipart/alternative...
  641. if MessageParts.TextPartCount > 1 then begin
  642. if MessageParts.AttachmentCount > 0 then begin
  643. ContentType := 'multipart/mixed'; {do not localize}
  644. end else begin
  645. ContentType := 'multipart/alternative'; {do not localize}
  646. end;
  647. end else
  648. begin
  649. //Just one (or 0?) text part.
  650. if MessageParts.AttachmentCount > 0 then begin
  651. ContentType := 'multipart/mixed'; {do not localize}
  652. end else begin
  653. ContentType := 'text/plain'; {do not localize}
  654. end;
  655. end;
  656. end;
  657. TIdMessageEncoderInfo(MessageParts.MessageEncoderInfo).InitializeHeaders(Self);
  658. end;
  659. InitializeISO(HeaderEncoding, ISOCharSet);
  660. FLastGeneratedHeaders.Assign(FHeaders);
  661. FIsMsgSinglePartMime := (Encoding = meMIME) and (MessageParts.Count = 1) and IsBodyEmpty;
  662. // TODO: when STRING_IS_ANSI is defined, provide a way for the user to specify the AnsiString encoding for header values...
  663. {CC: If From has no Name field, use the Address field as the Name field by setting last param to True (for SA)...}
  664. FLastGeneratedHeaders.Values['From'] := EncodeAddress(FromList, HeaderEncoding, ISOCharSet, True); {do not localize}
  665. FLastGeneratedHeaders.Values['Subject'] := EncodeHeader(Subject, '', HeaderEncoding, ISOCharSet); {do not localize}
  666. FLastGeneratedHeaders.Values['To'] := EncodeAddress(Recipients, HeaderEncoding, ISOCharSet); {do not localize}
  667. FLastGeneratedHeaders.Values['Cc'] := EncodeAddress(CCList, HeaderEncoding, ISOCharSet); {do not localize}
  668. {CC: SaveToFile sets FSavingToFile to True so that BCC names are saved
  669. when saving to file and omitted otherwise (as required by SMTP)...}
  670. if not FSavingToFile then begin
  671. FLastGeneratedHeaders.Values['Bcc'] := ''; {do not localize}
  672. end else begin
  673. FLastGeneratedHeaders.Values['Bcc'] := EncodeAddress(BCCList, HeaderEncoding, ISOCharSet); {do not localize}
  674. end;
  675. FLastGeneratedHeaders.Values['Newsgroups'] := NewsGroups.CommaText; {do not localize}
  676. if Encoding = meMIME then
  677. begin
  678. if IsMsgSinglePartMime then begin
  679. {This is a single-part MIME: the part may be a text part or an attachment.
  680. The relevant headers need to be taken from MessageParts[0]. The problem,
  681. however, is that we have not yet processed MessageParts[0] yet, so we do
  682. not have its properties or header content properly set up. So we will
  683. let the processing of MessageParts[0] append its headers to the message
  684. headers, i.e. DON'T generate Content-Type or Content-Transfer-Encoding
  685. headers here.}
  686. FLastGeneratedHeaders.Values['MIME-Version'] := '1.0'; {do not localize}
  687. {RLebeau: need to wipe out the following headers if they were present,
  688. otherwise MessageParts[0] will duplicate them instead of replacing them.
  689. This is because LastGeneratedHeaders is sent before MessageParts[0] is
  690. processed.}
  691. FLastGeneratedHeaders.Values['Content-Type'] := '';
  692. FLastGeneratedHeaders.Values['Content-Transfer-Encoding'] := '';
  693. FLastGeneratedHeaders.Values['Content-Disposition'] := '';
  694. end else begin
  695. if FContentType <> '' then begin
  696. LCharSet := FCharSet;
  697. if (LCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  698. LCharSet := 'us-ascii'; {do not localize}
  699. end;
  700. FLastGeneratedHeaders.Values['Content-Type'] := FContentType; {do not localize}
  701. FLastGeneratedHeaders.Params['Content-Type', 'charset'] := LCharSet; {do not localize}
  702. if (MessageParts.Count > 0) and (LMIMEBoundary <> '') then begin
  703. FLastGeneratedHeaders.Params['Content-Type', 'boundary'] := LMIMEBoundary; {do not localize}
  704. end;
  705. end;
  706. {CC2: We may have MIME with no parts if ConvertPreamble is True}
  707. FLastGeneratedHeaders.Values['MIME-Version'] := '1.0'; {do not localize}
  708. FLastGeneratedHeaders.Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
  709. end;
  710. end else begin
  711. //CC: non-MIME can have ContentTransferEncoding of base64, quoted-printable...
  712. LCharSet := FCharSet;
  713. if (LCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  714. LCharSet := 'us-ascii'; {do not localize}
  715. end;
  716. FLastGeneratedHeaders.Values['Content-Type'] := FContentType; {do not localize}
  717. FLastGeneratedHeaders.Params['Content-Type', 'charset'] := LCharSet; {do not localize}
  718. FLastGeneratedHeaders.Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
  719. end;
  720. FLastGeneratedHeaders.Values['Sender'] := EncodeAddressItem(Sender, HeaderEncoding, ISOCharSet); {do not localize}
  721. FLastGeneratedHeaders.Values['Reply-To'] := EncodeAddress(ReplyTo, HeaderEncoding, ISOCharSet); {do not localize}
  722. FLastGeneratedHeaders.Values['Organization'] := EncodeHeader(Organization, '', HeaderEncoding, ISOCharSet); {do not localize}
  723. LReceiptRecipient := EncodeAddressItem(ReceiptRecipient, HeaderEncoding, ISOCharSet);
  724. FLastGeneratedHeaders.Values['Disposition-Notification-To'] := LReceiptRecipient; {do not localize}
  725. FLastGeneratedHeaders.Values['Return-Receipt-To'] := LReceiptRecipient; {do not localize}
  726. FLastGeneratedHeaders.Values['References'] := References; {do not localize}
  727. if UseNowForDate then begin
  728. LDate := Now;
  729. end else begin
  730. LDate := Self.Date;
  731. end;
  732. FLastGeneratedHeaders.Values['Date'] := LocalDateTimeToGMT(LDate); {do not localize}
  733. // S.G. 27/1/2003: Only issue X-Priority header if priority <> mpNormal (for stoopid spam filters)
  734. // RLebeau 2/2/2014: add a new Importance property
  735. if Priority <> mpNormal then begin
  736. FLastGeneratedHeaders.Values['Priority'] := cPriorityStrs[Priority]; {do not localize}
  737. FLastGeneratedHeaders.Values['X-Priority'] := IntToStr(Ord(Priority) + 1); {do not localize}
  738. FLastGeneratedHeaders.Values['Importance'] := cImportanceStrs[Priority]; {do not localize}
  739. end else begin
  740. FLastGeneratedHeaders.Values['Priority'] := ''; {do not localize}
  741. FLastGeneratedHeaders.Values['X-Priority'] := ''; {do not localize}
  742. FLastGeneratedHeaders.Values['Importance'] := ''; {do not localize}
  743. end;
  744. FLastGeneratedHeaders.Values['Message-ID'] := MsgId;
  745. // RLebeau 9/12/2016: no longer auto-generating In-Reply-To based on
  746. // Message-ID. Many email servers will reject an outgoing email that
  747. // does not have a client-assigned Message-ID, and this method does not
  748. // know whether this email is a new message or a response to another
  749. // email when generating headers. If the calling app wants to send
  750. // In-Reply-To, it will just have to populate that header like any other.
  751. FLastGeneratedHeaders.Values['In-Reply-To'] := InReplyTo; {do not localize}
  752. // Add extra headers created by UA - allows duplicates
  753. if (FExtraHeaders.Count > 0) then begin
  754. FLastGeneratedHeaders.AddStrings(FExtraHeaders);
  755. end;
  756. {TODO: Generate Message-ID if at all possible to pacify SA. Do this after FExtraHeaders
  757. added in case there is a message-ID present as an extra header.}
  758. {
  759. if FLastGeneratedHeaders.Values['Message-ID'] = '' then begin //do not localize
  760. FLastGeneratedHeaders.Values['Message-ID'] := '<' + IntToStr(Abs( CurrentProcessId )) + '.' + IntToStr(Abs( GetClockValue )) + '@' + GStack.HostName + '>'; //do not localize
  761. end;
  762. }
  763. end;
  764. procedure TIdMessage.ProcessHeaders;
  765. var
  766. LBoundary: string;
  767. LMIMEVersion: string;
  768. // Some mailers send priority as text, number or combination of both
  769. function GetMsgPriority(APriority: string): TIdMessagePriority;
  770. var
  771. s: string;
  772. Num: integer;
  773. begin
  774. APriority := LowerCase(APriority);
  775. // TODO: use PostInStrArray() instead of IndyPos()
  776. // This is for Pegasus / X-MSMail-Priority / Importance headers
  777. if (IndyPos('non-urgent', APriority) <> 0) or {do not localize}
  778. (IndyPos('low', APriority) <> 0) then {do not localize}
  779. begin
  780. Result := mpLowest;
  781. // Although a matter of choice, IMO mpLowest is better choice than mpLow,
  782. // various examples on the net also use 1 as urgent and 5 as non-urgent
  783. end
  784. else if (IndyPos('urgent', APriority) <> 0) or {do not localize}
  785. (IndyPos('high', APriority) <> 0) then {do not localize}
  786. begin
  787. Result := mpHighest;
  788. // Although a matter of choice, IMO mpHighest is better choice than mpHigh,
  789. // various examples on the net also use 1 as urgent and 5 as non-urgent
  790. end else
  791. begin
  792. s := Trim(APriority);
  793. Num := IndyStrToInt(Fetch(s, ' '), 3); {do not localize}
  794. if (Num < 1) or (Num > 5) then begin
  795. Num := 3;
  796. end;
  797. Result := TIdMessagePriority(Num - 1);
  798. end;
  799. end;
  800. begin
  801. // RLebeau: per RFC 2045 Section 5.2:
  802. //
  803. // Default RFC 822 messages without a MIME Content-Type header are taken
  804. // by this protocol to be plain text in the US-ASCII character set,
  805. // which can be explicitly specified as:
  806. //
  807. // Content-type: text/plain; charset=us-ascii
  808. //
  809. // This default is assumed if no Content-Type header field is specified.
  810. // It is also recommend that this default be assumed when a
  811. // syntactically invalid Content-Type header field is encountered. In
  812. // the presence of a MIME-Version header field and the absence of any
  813. // Content-Type header field, a receiving User Agent can also assume
  814. // that plain US-ASCII text was the sender's intent. Plain US-ASCII
  815. // text may still be assumed in the absence of a MIME-Version or the
  816. // presence of an syntactically invalid Content-Type header field, but
  817. // the sender's intent might have been otherwise.
  818. FContentType := Headers.Values['Content-Type']; {do not localize}
  819. if FContentType = '' then begin
  820. FContentType := 'text/plain'; {do not localize}
  821. FCharSet := 'us-ascii'; {do not localize}
  822. end else begin
  823. FContentType := RemoveHeaderEntry(FContentType, 'charset', FCharSet, QuoteMIME); {do not localize}
  824. if (FCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  825. FCharSet := 'us-ascii'; {do not localize}
  826. end;
  827. end;
  828. ContentTransferEncoding := Headers.Values['Content-Transfer-Encoding']; {do not localize}
  829. ContentDisposition := Headers.Values['Content-Disposition']; {do not localize}
  830. Subject := DecodeHeader(Headers.Values['Subject']); {do not localize}
  831. DecodeAddresses(Headers.Values['From'], FromList); {do not localize}
  832. MsgId := Headers.Values['Message-Id']; {do not localize}
  833. CommaSeparatedToStringList(Newsgroups, Headers.Values['Newsgroups']); {do not localize}
  834. DecodeAddresses(Headers.Values['To'], Recipients); {do not localize}
  835. DecodeAddresses(Headers.Values['Cc'], CCList); {do not localize}
  836. {CC2: Added support for BCCList...}
  837. DecodeAddresses(Headers.Values['Bcc'], BCCList); {do not localize}
  838. Organization := Headers.Values['Organization']; {do not localize}
  839. InReplyTo := Headers.Values['In-Reply-To']; {do not localize}
  840. ReceiptRecipient.Text := Headers.Values['Disposition-Notification-To']; {do not localize}
  841. if Length(ReceiptRecipient.Text) = 0 then begin
  842. ReceiptRecipient.Text := Headers.Values['Return-Receipt-To']; {do not localize}
  843. end;
  844. References := Headers.Values['References']; {do not localize}
  845. DecodeAddresses(Headers.Values['Reply-To'], ReplyTo); {do not localize}
  846. Date := GMTToLocalDateTime(Headers.Values['Date']); {do not localize}
  847. Sender.Text := Headers.Values['Sender']; {do not localize}
  848. // RLebeau 2/2/2014: add a new Importance property
  849. if Length(Headers.Values['X-Priority']) > 0 then begin {do not localize}
  850. // Examine X-Priority first - to get better resolution if possible and because it is the most common
  851. Priority := GetMsgPriority(Headers.Values['X-Priority']); {do not localize}
  852. end
  853. else if Length(Headers.Values['Priority']) > 0 then begin {do not localize}
  854. // Which header should be here is matter of a bit of research, it might be that Importance might be checked first
  855. Priority := GetMsgPriority(Headers.Values['Priority']) {do not localize}
  856. end
  857. else if Length(Headers.Values['Importance']) > 0 then begin {do not localize}
  858. // Check Importance or Priority
  859. Priority := GetMsgPriority(Headers.Values['Importance']) {do not localize}
  860. end
  861. else if Length(Headers.Values['X-MSMail-Priority']) > 0 then begin {do not localize}
  862. // This is the least common header (or at least should be) so can be checked last
  863. Priority := GetMsgPriority(Headers.Values['X-MSMail-Priority']) {do not localize}
  864. end
  865. else begin
  866. Priority := mpNormal;
  867. end;
  868. {Note that the following code ensures MIMEBoundary.Count is 0 for single-part MIME messages...}
  869. FContentType := RemoveHeaderEntry(FContentType, 'boundary', LBoundary, QuoteMIME); {do not localize}
  870. if LBoundary <> '' then begin
  871. MIMEBoundary.Push(LBoundary, -1);
  872. end;
  873. {CC2: Set MESSAGE_LEVEL "encoding" (really the format or layout)}
  874. LMIMEVersion := Headers.Values['MIME-Version']; {do not localize}
  875. if LMIMEVersion = '' then begin
  876. Encoding := mePlainText;
  877. end else begin
  878. // TODO: this should be true if a MIME boundary is present.
  879. // The MIME version is optional...
  880. Encoding := meMIME;
  881. end;
  882. end;
  883. procedure TIdMessage.SetBccList(const AValue: TIdEmailAddressList);
  884. begin
  885. FBccList.Assign(AValue);
  886. end;
  887. procedure TIdMessage.SetBody(const AValue: TStrings);
  888. begin
  889. FBody.Assign(AValue);
  890. end;
  891. procedure TIdMessage.SetCCList(const AValue: TIdEmailAddressList);
  892. begin
  893. FCcList.Assign(AValue);
  894. end;
  895. procedure TIdMessage.SetContentType(const AValue: String);
  896. var
  897. LCharSet: String;
  898. begin
  899. // RLebeau: per RFC 2045 Section 5.2:
  900. //
  901. // Default RFC 822 messages without a MIME Content-Type header are taken
  902. // by this protocol to be plain text in the US-ASCII character set,
  903. // which can be explicitly specified as:
  904. //
  905. // Content-type: text/plain; charset=us-ascii
  906. //
  907. // This default is assumed if no Content-Type header field is specified.
  908. // It is also recommend that this default be assumed when a
  909. // syntactically invalid Content-Type header field is encountered. In
  910. // the presence of a MIME-Version header field and the absence of any
  911. // Content-Type header field, a receiving User Agent can also assume
  912. // that plain US-ASCII text was the sender's intent. Plain US-ASCII
  913. // text may still be assumed in the absence of a MIME-Version or the
  914. // presence of an syntactically invalid Content-Type header field, but
  915. // the sender's intent might have been otherwise.
  916. if AValue <> '' then
  917. begin
  918. FContentType := RemoveHeaderEntry(AValue, 'charset', LCharSet, QuoteMIME); {do not localize}
  919. {RLebeau: the ContentType property is streamed after the CharSet property,
  920. so do not overwrite it during streaming}
  921. if csReading in ComponentState then begin
  922. Exit;
  923. end;
  924. if (LCharSet = '') and (FCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
  925. LCharSet := 'us-ascii'; {do not localize}
  926. end;
  927. {RLebeau: override the current CharSet only if the header specifies a new value}
  928. if LCharSet <> '' then begin
  929. FCharSet := LCharSet;
  930. end;
  931. end else
  932. begin
  933. FContentType := 'text/plain'; {do not localize}
  934. {RLebeau: the ContentType property is streamed after the CharSet property,
  935. so do not overwrite it during streaming}
  936. if not (csReading in ComponentState) then begin
  937. FCharSet := 'us-ascii'; {do not localize}
  938. end;
  939. end;
  940. end;
  941. procedure TIdMessage.SetExtraHeaders(const AValue: TIdHeaderList);
  942. begin
  943. FExtraHeaders.Assign(AValue);
  944. end;
  945. procedure TIdMessage.SetFrom(const AValue: TIdEmailAddressItem);
  946. begin
  947. GetFrom.Assign(AValue);
  948. end;
  949. function TIdMessage.GetFrom: TIdEmailAddressItem;
  950. begin
  951. if FFromList.Count = 0 then begin
  952. FFromList.Add;
  953. end;
  954. Result := FFromList[0];
  955. end;
  956. procedure TIdMessage.SetFromList(const AValue: TIdEmailAddressList);
  957. begin
  958. FFromList.Assign(AValue);
  959. end;
  960. procedure TIdMessage.SetHeaders(const AValue: TIdHeaderList);
  961. begin
  962. FHeaders.Assign(AValue);
  963. end;
  964. procedure TIdMessage.SetNewsGroups(const AValue: TStrings);
  965. begin
  966. FNewsgroups.Assign(AValue);
  967. end;
  968. procedure TIdMessage.SetReceiptRecipient(const AValue: TIdEmailAddressItem);
  969. begin
  970. FReceiptRecipient.Assign(AValue);
  971. end;
  972. procedure TIdMessage.SetRecipients(const AValue: TIdEmailAddressList);
  973. begin
  974. FRecipients.Assign(AValue);
  975. end;
  976. procedure TIdMessage.SetReplyTo(const AValue: TIdEmailAddressList);
  977. begin
  978. FReplyTo.Assign(AValue);
  979. end;
  980. procedure TIdMessage.SetSender(const AValue: TIdEmailAddressItem);
  981. begin
  982. FSender.Assign(AValue);
  983. end;
  984. function TIdMessage.GetUseNowForDate: Boolean;
  985. begin
  986. Result := (FDate = 0);
  987. end;
  988. procedure TIdMessage.SetUseNowForDate(const AValue: Boolean);
  989. begin
  990. if GetUseNowForDate <> AValue then begin
  991. if AValue then begin
  992. FDate := 0;
  993. end else begin
  994. FDate := Now;
  995. end;
  996. end;
  997. end;
  998. procedure TIdMessage.SetAttachmentEncoding(const AValue: string);
  999. begin
  1000. MessageParts.AttachmentEncoding := AValue;
  1001. end;
  1002. function TIdMessage.GetAttachmentEncoding: string;
  1003. begin
  1004. Result := MessageParts.AttachmentEncoding;
  1005. end;
  1006. procedure TIdMessage.SetEncoding(const AValue: TIdMessageEncoding);
  1007. begin
  1008. FEncoding := AValue;
  1009. if AValue = meMIME then begin
  1010. AttachmentEncoding := 'MIME'; {do not localize}
  1011. end else begin
  1012. //Default to UUE for mePlainText, user can override to XXE by calling
  1013. //TIdMessage.AttachmentEncoding := 'XXE';
  1014. AttachmentEncoding := 'UUE'; {do not localize}
  1015. end;
  1016. end;
  1017. procedure TIdMessage.LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False);
  1018. var
  1019. LStream: TIdReadFileExclusiveStream;
  1020. begin
  1021. if not FileExists(AFilename) then begin
  1022. raise EIdMessageCannotLoad.CreateFmt(RSIdMessageCannotLoad, [AFilename]);
  1023. end;
  1024. LStream := TIdReadFileExclusiveStream.Create(AFilename); try
  1025. LoadFromStream(LStream, AHeadersOnly);
  1026. finally FreeAndNil(LStream); end;
  1027. end;
  1028. procedure TIdMessage.LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False);
  1029. var
  1030. LMsgClient: TIdMessageClient;
  1031. begin
  1032. // clear message properties, headers before loading
  1033. Clear;
  1034. LMsgClient := TIdMessageClient.Create;
  1035. try
  1036. LMsgClient.ProcessMessage(Self, AStream, AHeadersOnly);
  1037. finally
  1038. LMsgClient.Free;
  1039. end;
  1040. end;
  1041. procedure TIdMessage.SaveToFile(const AFileName: string; const AHeadersOnly: Boolean = False);
  1042. var
  1043. LStream : TFileStream;
  1044. begin
  1045. LStream := TIdFileCreateStream.Create(AFileName); try
  1046. FSavingToFile := True; try
  1047. SaveToStream(LStream, AHeadersOnly);
  1048. finally FSavingToFile := False; end;
  1049. finally FreeAndNil(LStream); end;
  1050. end;
  1051. procedure TIdMessage.SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False);
  1052. var
  1053. LMsgClient: TIdMessageClient;
  1054. LIOHandler: TIdIOHandlerStream;
  1055. begin
  1056. LMsgClient := TIdMessageClient.Create(nil); try
  1057. LIOHandler := TIdIOHandlerStream.Create(nil, nil, AStream); try
  1058. LIOHandler.FreeStreams := False;
  1059. LMsgClient.IOHandler := LIOHandler;
  1060. LMsgClient.SendMsg(Self, AHeadersOnly);
  1061. // add the end of message marker when body is included
  1062. if not AHeadersOnly then begin
  1063. LMsgClient.IOHandler.WriteLn('.'); {do not localize}
  1064. end;
  1065. finally FreeAndNil(LIOHandler); end;
  1066. finally FreeAndNil(LMsgClient); end;
  1067. end;
  1068. procedure TIdMessage.DoInitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
  1069. begin
  1070. if Assigned(FOnInitializeISO) then begin
  1071. FOnInitializeISO(VHeaderEncoding, VCharSet);//APR
  1072. end;
  1073. end;
  1074. procedure TIdMessage.InitializeISO(var VHeaderEncoding: Char; var VCharSet: String);
  1075. var
  1076. LDefCharset: TIdCharSet;
  1077. begin
  1078. // it's not clear when FHeaderEncoding should be Q not B.
  1079. // Comments welcome on atozedsoftware.indy.general
  1080. LDefCharset := IdGetDefaultCharSet;
  1081. case LDefCharset of
  1082. idcs_ISO_8859_1:
  1083. begin
  1084. VHeaderEncoding := 'Q'; { quoted-printable } {Do not Localize}
  1085. VCharSet := IdCharsetNames[LDefCharset];
  1086. end;
  1087. idcs_UNICODE_1_1:
  1088. begin
  1089. VHeaderEncoding := 'B'; { base64 } {Do not Localize}
  1090. VCharSet := IdCharsetNames[idcs_UTF_8];
  1091. end;
  1092. else
  1093. begin
  1094. VHeaderEncoding := 'B'; { base64 } {Do not Localize}
  1095. VCharSet := IdCharsetNames[LDefCharset];
  1096. end;
  1097. end;
  1098. DoInitializeISO(VHeaderEncoding, VCharSet);
  1099. end;
  1100. procedure TIdMessage.DoCreateAttachment(const AHeaders: TStrings;
  1101. var VAttachment: TIdAttachment);
  1102. begin
  1103. VAttachment := nil;
  1104. if Assigned(FOnCreateAttachment) then begin
  1105. FOnCreateAttachment(Self, AHeaders, VAttachment);
  1106. end;
  1107. if VAttachment = nil then begin
  1108. VAttachment := TIdAttachmentFile.Create(MessageParts);
  1109. end;
  1110. end;
  1111. function TIdMessage.IsBodyEncodingRequired: Boolean;
  1112. var
  1113. i,j: Integer;
  1114. S: String;
  1115. begin
  1116. Result := False;//7bit
  1117. for i:= 0 to FBody.Count - 1 do begin
  1118. S := FBody[i];
  1119. for j := 1 to Length(S) do begin
  1120. if S[j] > #127 then begin
  1121. Result := True;
  1122. Exit;
  1123. end;
  1124. end;
  1125. end;
  1126. end;//
  1127. function TIdMessage.GetInReplyTo: String;
  1128. begin
  1129. Result := EnsureMsgIDBrackets(FInReplyTo);
  1130. end;
  1131. procedure TIdMessage.SetInReplyTo(const AValue: String);
  1132. begin
  1133. FInReplyTo := EnsureMsgIDBrackets(AValue);
  1134. end;
  1135. // TODO: add this?
  1136. {
  1137. procedure TIdMessage.GetMsgID: String;
  1138. begin
  1139. Result := EnsureMsgIDBrackets(FMsgId);
  1140. end;
  1141. }
  1142. procedure TIdMessage.SetMsgID(const AValue: String);
  1143. begin
  1144. FMsgId := EnsureMsgIDBrackets(AValue);
  1145. end;
  1146. procedure TIdMessage.SetAttachmentTempDirectory(const Value: string);
  1147. begin
  1148. if Value <> AttachmentTempDirectory then begin
  1149. FAttachmentTempDirectory := IndyExcludeTrailingPathDelimiter(Value);
  1150. end;
  1151. end;
  1152. end.