PageRenderTime 41ms CodeModel.GetById 22ms RepoModel.GetById 0ms app.codeStats 2ms

/ProSnooperFx_src/indy10.0.52_source/Protocols/IdIMAP4.pas

http://github.com/lookias/ProSnooper
Pascal | 6600 lines | 4687 code | 264 blank | 1649 comment | 708 complexity | ec27c6e2f5e54696e1225257f3a7e214 MD5 | raw file
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 11627: IdIMAP4.pas
  11. {
  12. Rev 1.57 11/8/2004 8:39:00 AM DSiders
  13. Removed comment in TIdIMAP4.SearchMailBox implementation that caused DOM
  14. problem when locating the symbol id.
  15. }
  16. {
  17. { Rev 1.56 10/26/2004 10:19:58 PM JPMugaas
  18. { Updated refs.
  19. }
  20. {
  21. { Rev 1.55 2004.10.26 2:19:56 PM czhower
  22. { Resolved alias conflict.
  23. }
  24. {
  25. Rev 1.54 6/11/2004 9:36:34 AM DSiders
  26. Added "Do not Localize" comments.
  27. }
  28. {
  29. { Rev 1.53 6/4/04 12:48:12 PM RLebeau
  30. { ContentTransferEncoding bug fix
  31. }
  32. {
  33. { Rev 1.52 01/06/2004 19:03:46 CCostelloe
  34. { .NET bug fix
  35. }
  36. {
  37. { Rev 1.51 01/06/2004 01:16:18 CCostelloe
  38. { Various improvements
  39. }
  40. {
  41. { Rev 1.50 20/05/2004 22:04:14 CCostelloe
  42. { IdStreamVCL changes
  43. }
  44. {
  45. { Rev 1.49 20/05/2004 08:43:12 CCostelloe
  46. { IdStream change
  47. }
  48. {
  49. { Rev 1.48 16/05/2004 20:40:46 CCostelloe
  50. { New TIdText/TIdAttachment processing
  51. }
  52. {
  53. { Rev 1.47 24/04/2004 23:54:42 CCostelloe
  54. { IMAP-style UTF-7 encoding/decoding of mailbox names added
  55. }
  56. {
  57. { Rev 1.46 13/04/2004 22:24:28 CCostelloe
  58. { Bug fix (FCapabilities not created if not DOTNET)
  59. }
  60. {
  61. { Rev 1.45 3/18/2004 2:32:40 AM JPMugaas
  62. { Should compile under D8 properly.
  63. }
  64. {
  65. { Rev 1.44 3/8/2004 10:10:32 AM JPMugaas
  66. { IMAP4 should now have SASLMechanisms again. Those work in DotNET now.
  67. { SSL abstraction is now supported even in DotNET so that should not be
  68. { IFDEF'ed out.
  69. }
  70. {
  71. { Rev 1.43 07/03/2004 17:55:16 CCostelloe
  72. { Updates to cover changes in other units
  73. }
  74. {
  75. { Rev 1.42 2/4/2004 2:36:58 AM JPMugaas
  76. { Moved more units down to the implementation clause in the units to make them
  77. { easier to compile.
  78. }
  79. {
  80. { Rev 1.41 2/3/2004 4:12:50 PM JPMugaas
  81. { Fixed up units so they should compile.
  82. }
  83. {
  84. { Rev 1.40 2004.02.03 5:43:48 PM czhower
  85. { Name changes
  86. }
  87. {
  88. { Rev 1.39 2004.02.03 2:12:10 PM czhower
  89. { $I path change
  90. }
  91. {
  92. { Rev 1.38 1/27/2004 4:01:12 PM SPerry
  93. { StringStream ->IdStringStream
  94. }
  95. {
  96. { Rev 1.37 1/25/2004 3:11:12 PM JPMugaas
  97. { SASL Interface reworked to make it easier for developers to use.
  98. { SSL and SASL reenabled components.
  99. }
  100. {
  101. { Rev 1.36 23/01/2004 01:48:28 CCostelloe
  102. { Added BinHex4.0 encoding support for parts
  103. }
  104. {
  105. { Rev 1.35 1/21/2004 3:10:40 PM JPMugaas
  106. { InitComponent
  107. }
  108. {
  109. { Rev 1.34 31/12/2003 09:40:32 CCostelloe
  110. { ChangeReplyClass removed, replaced AnsiSameText with TextIsSame, stream code
  111. { not tested.
  112. }
  113. { Rev 1.33 28/12/2003 23:48:18 CCostelloe
  114. { More TEMPORARY fixes to get it to compile under D7 and D8 .NET
  115. }
  116. {
  117. { Rev 1.32 22/12/2003 01:20:20 CCostelloe
  118. { .NET fixes. This is a TEMPORARY combined Indy9/10/.NET master file.
  119. }
  120. {
  121. { Rev 1.31 14/12/2003 21:03:16 CCostelloe
  122. { First version for .NET
  123. }
  124. {
  125. { Rev 1.30 10/17/2003 12:11:06 AM DSiders
  126. { Added localization comments.
  127. { Added resource strings for exception messages.
  128. }
  129. {
  130. { Rev 1.29 2003.10.12 3:53:10 PM czhower
  131. { compile todos
  132. }
  133. {
  134. { Rev 1.28 10/12/2003 1:49:50 PM BGooijen
  135. { Changed comment of last checkin
  136. }
  137. {
  138. { Rev 1.27 10/12/2003 1:43:34 PM BGooijen
  139. { Changed IdCompilerDefines.inc to Core\IdCompilerDefines.inc
  140. }
  141. {
  142. { Rev 1.26 20/09/2003 15:38:38 CCostelloe
  143. { More patches added for different IMAP servers
  144. }
  145. {
  146. { Rev 1.25 12/08/2003 01:17:38 CCostelloe
  147. { Retrieve and AppendMsg updated to suit changes made to attachment encoding
  148. { changes in other units
  149. }
  150. {
  151. { Rev 1.24 21/07/2003 01:22:24 CCostelloe
  152. { Added CopyMsg and UIDCopyMsgs. (UID)Receive(Peek) rewritten. AppendMsg
  153. { still buggy with attachments. Public variable FGreetingBanner added. Added
  154. { "if Connected then " to Destroy. Attachment filenames now decoded if
  155. { necessary. Added support for multisection parts. Resolved issue of some
  156. { servers leaving out the trailing "NIL NIL NIL" at the end of some body
  157. { structures. UIDRetrieveAllHeaders removed
  158. }
  159. {
  160. { Rev 1.23 18/06/2003 21:53:36 CCostelloe
  161. { Rewrote GetResponse from scratch. Restored Capabilities for login. Compiles
  162. { and runs properly (may be a couple of minor bugs not yet discovered).
  163. }
  164. {
  165. { Rev 1.22 6/16/2003 11:48:18 PM JPMugaas
  166. { Capabilities has to be restored for SASL and SSL support.
  167. }
  168. {
  169. { Rev 1.21 17/06/2003 01:33:46 CCostelloe
  170. { Updated to support new LoginSASL. Compiles OK, may not yet run OK.
  171. }
  172. {
  173. { Rev 1.20 12/06/2003 10:17:54 CCostelloe
  174. { Partial update for Indy 10's new Reply structure. Compiles but does not run
  175. { correctly. Checked in to show problem with Get/SetNumericCode in IdReplyIMAP.
  176. }
  177. {
  178. { Rev 1.19 04/06/2003 02:33:44 CCostelloe
  179. { Compiles under Indy 10 with the revised Indy 10 structure, but does not yet
  180. { work properly due to some of the changes. Will be fixed by me in a later
  181. { check-in.
  182. }
  183. {
  184. { Rev 1.18 14/05/2003 01:55:50 CCostelloe
  185. { This version (with the extra IMAP functionality recently added) now compiles
  186. { on Indy 10 and works in a real application.
  187. }
  188. {
  189. { Rev 1.17 5/12/2003 02:19:56 AM JPMugaas
  190. { Now should work properly again. I also removed all warnings and errors in
  191. { Indy 10.
  192. }
  193. {
  194. { Rev 1.16 5/11/2003 07:35:44 PM JPMugaas
  195. }
  196. {
  197. { Rev 1.15 5/11/2003 07:11:06 PM JPMugaas
  198. { Fixed to eliminate some warnings and compile errors in Indy 10.
  199. }
  200. {
  201. { Rev 1.14 11/05/2003 23:53:52 CCostelloe
  202. { Bug fix due to Windows 98 / 2000 discrepancies
  203. }
  204. {
  205. { Rev 1.13 11/05/2003 23:08:36 CCostelloe
  206. { Lots more bug fixes, plus IMAP code moved up from IdRFCReply
  207. }
  208. {
  209. { Rev 1.12 5/10/2003 07:31:22 PM JPMugaas
  210. { Updated with some bug fixes and some cleanups.
  211. }
  212. {
  213. { Rev 1.11 5/9/2003 10:51:26 AM JPMugaas
  214. { Bug fixes. Now works as it should. Verified.
  215. }
  216. {
  217. { Rev 1.9 5/9/2003 03:49:44 AM JPMugaas
  218. { IMAP4 now supports SASL. Merged some code from Ciaran which handles the +
  219. { SASL continue reply in IMAP4 and makes a few improvements. Verified to work
  220. { on two servers.
  221. }
  222. {
  223. { Rev 1.8 5/8/2003 05:41:48 PM JPMugaas
  224. { Added constant for SASL continuation.
  225. }
  226. {
  227. { Rev 1.7 5/8/2003 03:17:50 PM JPMugaas
  228. { Flattened ou the SASL authentication API, made a custom descendant of SASL
  229. { enabled TIdMessageClient classes.
  230. }
  231. {
  232. { Rev 1.6 5/8/2003 11:27:52 AM JPMugaas
  233. { Moved feature negoation properties down to the ExplicitTLSClient level as
  234. { feature negotiation goes hand in hand with explicit TLS support.
  235. }
  236. {
  237. { Rev 1.5 5/8/2003 02:17:44 AM JPMugaas
  238. { Fixed an AV in IdPOP3 with SASL list on forms. Made exceptions for SASL
  239. { mechanisms missing more consistant, made IdPOP3 support feature feature
  240. { negotiation, and consolidated some duplicate code.
  241. }
  242. {
  243. { Rev 1.4 5/7/2003 10:20:32 PM JPMugaas
  244. }
  245. {
  246. { Rev 1.3 5/7/2003 04:35:30 AM JPMugaas
  247. { IMAP4 should now compile. Started on prelimary SSL support (not finished
  248. { yet).
  249. }
  250. {
  251. { Rev 1.2 15/04/2003 00:57:08 CCostelloe
  252. }
  253. {
  254. { Rev 1.1 2/24/2003 09:03:06 PM JPMugaas
  255. }
  256. {
  257. { Rev 1.0 11/13/2002 07:54:50 AM JPMugaas
  258. }
  259. unit IdIMAP4;
  260. {*
  261. IMAP 4 (Internet Message Access Protocol - Version 4 Rev 1)
  262. By Idan Cohen i_cohen@yahoo.com
  263. 2001-FEB-27 IC: First version most of the IMAP features are implemented and
  264. the core IdPOP3 features are implemented to allow a seamless
  265. switch.
  266. The unit is currently oriented to a session connection and not
  267. to constant connection, because of that server events that are
  268. raised from another user actions are not supported.
  269. 2001-APR-18 IC: Added support for the session's connection state with a
  270. special exception for commands preformed in wrong connection
  271. states. Exceptions were also added for response errors.
  272. 2001-MAY-05 IC:
  273. 2001-Mar-13 DS: Fixed Bug # 494813 in CheckMsgSeen where LastCmdResult.Text
  274. was not using the Ln index variable to access server
  275. responses.
  276. 2002-Apr-12 DS: fixed bug # 506026 in TIdIMAP4.ListSubscribedMailBoxes. Call
  277. ParseLSubResut instead of ParseListResult.
  278. 2003-Mar-31 CC: Added GetUID and UIDSearchMailBox, sorted out some bugs (details
  279. shown in comments in those functions which start with "CC:").
  280. 2003-Apr-15 CC2:Sorted out some more bugs (details shown in comments in those
  281. functions which start with "CC2:"). Set FMailBoxSeparator
  282. in ParseListResult and ParseLSubResult.
  283. Some IMAP servers generally return "OK completed" even if they
  284. returned no data, such as passing a non-existent message
  285. number to them: they possibly should return NO or BAD; the
  286. functions here have been changed to return FALSE unless they
  287. get good data back, even if the server answers OK. Similar
  288. change made for other functions.
  289. There are a few exceptions, e.g. ListMailBoxes may only return
  290. "OK completed" if the user has no mailboxes, these are noted.
  291. Also, RetrieveStructure(), UIDRetrieveStructure, RetrievePart,
  292. UIDRetrievePart, RetrievePartPeek and UIDRetrievePartPeek
  293. added to allow user to find the structure of a message and
  294. just retrieve the part or parts he needs.
  295. 2003-Apr-30 CC3:Added functionality to retrieve the text of a message (only)
  296. via RetrieveText / UIDRetrieveText / RetrieveTextPeek /
  297. UIDRetrieveTextPeek.
  298. Return codes now generally reflect if the function succeeded
  299. instead of returning True even though function fails.
  300. 2003-May-15 CC4:Added functionality to retrieve individual parts of a message
  301. to a file, including the decoding of those parts.
  302. 2003-May-29 CC5:Response of some servers to UID version of commands varies,
  303. code changed to deal with those (UID position varies).
  304. Some servers return NO such as when you request an envelope
  305. for a message number that does not exist: functions return
  306. False instead of throwing an exception, as was done for other
  307. servers. The general logic is that if a valid result is
  308. returned from the IMAP server, return True; if there is no
  309. result (but the command is validly structured), return FALSE;
  310. if the command is badly structured or if it gives a response
  311. that this code does not expect, throw an exception (typically
  312. when we get a BAD response instead of OK or NO).
  313. Added IsNumberValid, IsUIDValid to prevent rubbishy parameters
  314. being passed through to IMAP functions.
  315. Sender field now filled in correctly in ParseEnvelope
  316. functions.
  317. All fields in ParseEnvelopeAddress are cleared out first,
  318. avoids an unwitting error where some entries, such as CC list,
  319. will append entries to existing entries.
  320. Full test script now used that tests every TIdIMAP command,
  321. more bugs eradicated.
  322. First version to pass testing against both CommuniGate and
  323. Cyrus IMAP servers.
  324. Not tested against Microsoft Exchange, don't have an Exchange
  325. account to test it against.
  326. 2003-Jun-10 CC6:Added (UID)RetrieveEnvelopeRaw, in case the user wants to do
  327. their own envelope parsing.
  328. Code in RetrievePart altered to make it more consistent.
  329. Altered to incorporate Indy 10's use of IdReplyIMAP4 (not
  330. complete at this stage).
  331. ReceiveBody added to IdIMAP4, due to the response of some
  332. servers, which gets (UID)Receive(Peek) functions to work on
  333. more servers.
  334. 2003-Jun-20 CC7:ReceiveBody altered to work with Indy 10. Made changes due to
  335. LoginSASL moving from TIdMessageSASLClient to TIdSASLList.
  336. Public variable FGreetingBanner added to help user identify
  337. the IMAP server he is connected to (may help him decide the
  338. best strategy). Made AppendMsg work a bit better (now uses
  339. platform-independent EOL and supports ExtraHeaders field).
  340. Added 2nd version of AppendMsg. Added "if Connected then "
  341. to Destroy. Attachment filenames now decoded if necessary.
  342. Added support for multisection parts.
  343. 2003-Jul-16 CC8:Added RemoveAnyAdditionalResponses. Resolved issue of some
  344. servers leaving out the trailing "NIL NIL NIL" at the end of
  345. some body structures. (UID)Retrieve(Peek) functions
  346. integrated via InternalRetrieve, new method of implementing
  347. these functions (all variations of Retrieve) added for Indy
  348. 10 based on getting message by the byte-count and then feeding
  349. it into the standard message parser.
  350. UIDRetrieveAllHeaders removed: it was never implemented anyway
  351. but it makes no sense to retrieve a non-contiguous list which
  352. would have gaps due to missing UIDs.
  353. In the Indy 10 version, AppendMsg functions were altered to
  354. support the sending of attachments (attachments had never
  355. been supported in AppendMsg prior to this).
  356. Added CopyMsg and UIDCopyMsgs to complete the command set.
  357. 2003-Jul-30 CC9:Removed wDoublePoint so that the code is compliant with
  358. the guidelines. Allowed for servers that don't implement
  359. search commands in Indy 9 (OK in 10). InternalRetrieve
  360. altered to (hopefully) deal with optional "FLAGS (\Seen)"
  361. in response.
  362. 2003-Aug-22 CCA:Yet another IMAP oddity - a server returns NIL for the
  363. mailbox separator, ParseListResult modified. Added "Length
  364. (LLine) > 0)" test to stop GPF on empty line in ReceiveBody.
  365. 2003-Sep-26 CCB:Changed SendCmd altered to try to remove anything that may
  366. be unprocessed from a previous (probably failed) command.
  367. This uses the property FMilliSecsToWaitToClearBuffer, which
  368. defaults to 10ms.
  369. Added EIdDisconnectedProbablyIdledOut, trapped in
  370. GetInternalResponse.
  371. Unsolicited responses now filtered out (they are now transferred
  372. from FLastCmdResult.Text to a new field, FLastCmdResult.Extra,
  373. leaving just the responses we want to our command in
  374. FLastCmdResult.Text).
  375. 2003-Oct-21 CCC:Original GetLineResponse merged with GetResponse to reduce
  376. complexity and to add filtering unsolicited responses when
  377. we are looking for single-line responses (which GetLineResponse
  378. did), removed/coded-out much of these functions to make the
  379. code much simpler.
  380. Removed RemoveAnyAdditionalResponses, no longer needed.
  381. Parsing of body structure reworked to support ParentPart concept
  382. allowing parsing of indefinitely-nested MIME parts. Note that
  383. a`MIME "alternative" message with a plain-text and a html part
  384. will have part[0] marked "alternative" with size 0 and ImapPartNumber
  385. of 1, a part[1] of type text/plain with a ParentPart of 0 and an
  386. ImapPartNumber of 1.1, and finally a part[2] of type text/html
  387. again with a ParentPart of 0 and an ImapPartNumber of 1.2.
  388. Imap part number changed from an integer to string, allowing
  389. retrieval of IMAP sub-parts, e.g. part '3.2' is the 2nd subpart
  390. of part 3.
  391. 2003-Nov-20 CCD:Added UIDRetrievePartHeader & RetrievePartHeader. Started to
  392. use an abstracted parsing method for the command response in
  393. UIDRetrieveFlags. Added function FindHowServerCreatesFolders.
  394. 2003-Dec-04 CCE:Copied DotNet connection changes from IdSMTP to tempoarily bypass
  395. the SASL authentications until they are ported.
  396. 2004-Jan-23 CCF:Finished .NET port, added BinHex4.0 encoding.
  397. 2004-Apr-16 CCG:Added UTF-7 decoding/encoding code kindly written and submitted by
  398. Roman Puls for encoding/decoding mailbox names. IMAP does not use
  399. standard UTF-7 code (what's new?!) so these routines are localised
  400. to this unit.
  401. *}
  402. { Todo -oIC :
  403. Change the mailbox list commands so that they receive TMailBoxTree
  404. structures and so they can store in them the mailbox name and it's attributes. }
  405. { Todo -oIC :
  406. Add support for \* special flag in messages, and check for \Recent
  407. flag in STORE command because it cant be stored (will get no reply!!!) }
  408. { Todo -oIC :
  409. 5.1.2. Mailbox Namespace Naming Convention
  410. By convention, the first hierarchical element of any mailbox name
  411. which begins with "#" identifies the "namespace" of the remainder of
  412. the name. This makes it possible to disambiguate between different
  413. types of mailbox stores, each of which have their own namespaces.
  414. For example, implementations which offer access to USENET
  415. newsgroups MAY use the "#news" namespace to partition the USENET
  416. newsgroup namespace from that of other mailboxes. Thus, the
  417. comp.mail.misc newsgroup would have an mailbox name of
  418. "#news.comp.mail.misc", and the name "comp.mail.misc" could refer
  419. to a different object (e.g. a user's private mailbox). } {Do not Localize}
  420. { TO BE CONSIDERED -CC :
  421. Double-quotes in mailbox names can cause major but subtle failures. Maybe
  422. add the automatic stripping of double-quotes if passed in mailbox names,
  423. to avoid ending up with ""INBOX""
  424. }
  425. interface
  426. {CC3: WARNING - if the following gives a "File not found" error on compilation,
  427. you need to add the path "C:\Program Files\Borland\Delphi7\Source\Indy" in
  428. Project -> Options -> Directories/Conditionals -> Search Path}
  429. {$I IdCompilerDefines.inc}
  430. uses
  431. IdMessage,
  432. Classes,
  433. IdAssignedNumbers,
  434. IdMailBox,
  435. IdException,
  436. IdGlobal,
  437. IdMessageParts,
  438. IdMessageClient,
  439. IdReply,
  440. IdComponent, {CC6: Now needed for ReceiveBody}
  441. IdMessageCoder, {CC2: Now needed for parsing BODYSTRUCTURE}
  442. IdHeaderList, {CC7: Added for 2nd version of AppendMsg}
  443. IdCoderHeader, {CC7: Needed for decoding filenames}
  444. IdCoderMIME,
  445. IdCoderQuotedPrintable,
  446. IdCoderBinHex4,
  447. IdSASLCollection, {JPM - SASL authentication for IMAP4 in Indy 10}
  448. IdTStrings,
  449. IdMessageCollection;
  450. { MUTF7 }
  451. type
  452. EmUTF7Encode = class(EIdSilentException);
  453. EmUTF7Decode = class(EIdSilentException);
  454. const
  455. b64Chars : array[0..63] of char =
  456. 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,'; {Do not Localize}
  457. b64Index : array [0..127] of integer = (
  458. -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, // 16
  459. -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, // 32
  460. -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,62,63,-1,-1,-1, // 48
  461. 52,53,54,55,56,57,58,59,60,61,-1,-1,-1,-1,-1,-1, // 64
  462. -1,00,01,02,03,04,05,06,07,08,09,10,11,12,13,14, // 80
  463. 15,16,17,18,19,20,21,22,23,24,25,-1,-1,-1,-1,-1, // 96
  464. -1,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, // 112
  465. 41,42,43,44,45,46,47,48,49,50,51,-1,-1,-1,-1,-1 // 128
  466. );
  467. b64Table : array[0..127] of integer = (
  468. $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, // 16
  469. $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF, // 32
  470. $20,$21,$22,$23, $24,$25,$FF,$27, $28,$29,$2A,$2B, $2C,$2D,$2E,$2F, // 48
  471. $30,$31,$32,$33, $34,$35,$36,$37, $38,$39,$3A,$3B, $3C,$3D,$3E,$3F, // 64
  472. $40,$41,$42,$43, $44,$45,$46,$47, $48,$49,$4A,$4B, $4C,$4D,$4E,$4F, // 80
  473. $50,$51,$52,$53, $54,$55,$56,$57, $58,$59,$5A,$5B, $5C,$5D,$5E,$5F, // 96
  474. $60,$61,$62,$63, $64,$65,$66,$67, $68,$69,$6A,$6B, $6C,$6D,$6E,$6F, // 112
  475. $70,$71,$72,$73, $74,$75,$76,$77, $78,$79,$7A,$7B, $7C,$7D,$7E,$FF);// 128
  476. type
  477. TIdMUTF7 = class(TObject)
  478. public
  479. function Encode(aString : string):string;
  480. function Decode(aString : string):string;
  481. function Valid(aMUTF7String : string):boolean;
  482. function Append(const aMUTF7String, aAnsiStr : string):string;
  483. end;
  484. { TIdIMAP4 }
  485. const
  486. wsOk = 1;
  487. wsNo = 2;
  488. wsBad = 3;
  489. wsPreAuth = 4;
  490. wsBye = 5;
  491. wsContinue = 6;
  492. type
  493. TIdIMAP4FolderTreatment = ( //Result codes from FindHowServerCreatesFolders
  494. ftAllowsTopLevelCreation, //Folders can be created at the same level as Inbox (the top level)
  495. ftFoldersMustBeUnderInbox, //Folders must be created under INBOX, such as INBOX.Sent
  496. ftDoesNotAllowFolderCreation, //Wont allow you create folders at top level or under Inbox (may be read-only connection)
  497. ftCannotTestBecauseHasNoInbox, //Wont allow top-level creation but cannot test creation under Inbox because it does not exist
  498. ftCannotRetrieveAnyFolders //No folders present for that user, cannot be determined
  499. );
  500. type
  501. TIdIMAP4AuthenticationType = (atUserPass, atSASL);
  502. const
  503. DEF_IMAP4_AUTH = atUserPass;
  504. IDF_DEFAULT_MS_TO_WAIT_TO_CLEAR_BUFFER = 10;
  505. {CC3: TIdImapMessagePart and TIdImapMessageParts added for retrieving
  506. individual parts of a message via IMAP, because IMAP uses some additional
  507. terms.
  508. Note that (rarely) an IMAP can have two sub-"parts" in the one part -
  509. they are sent in the one part by the server, typically a plain-text and
  510. html version with a boundary at the start, in between, and at the end.
  511. TIdIMAP fills in the boundary in that case, and the FSubpart holds the
  512. info on the second part. I call these multisection parts.}
  513. type
  514. TIdImapMessagePart = class(TCollectionItem)
  515. protected
  516. FBodyType: string;
  517. FBodySubType: string;
  518. FFileName: string;
  519. FDescription: string;
  520. FEncoding: TIdMessageEncoding;
  521. FContentTransferEncoding: string;
  522. FSize: integer;
  523. FUnparsedEntry: string; {Text returned from server: useful for debugging or workarounds}
  524. FBoundary: string; {Only used for multisection parts}
  525. FParentPart: Integer;
  526. FImapPartNumber: string;
  527. public
  528. property BodyType : String read FBodyType write FBodyType;
  529. property BodySubType : String read FBodySubType write FBodySubType;
  530. property FileName : String read FFileName write FFileName;
  531. property Description : String read FDescription write FDescription;
  532. property Encoding: TIdMessageEncoding read FEncoding write FEncoding;
  533. property ContentTransferEncoding : String read FContentTransferEncoding write FContentTransferEncoding;
  534. property Size : integer read FSize write FSize;
  535. property UnparsedEntry : string read FUnparsedEntry write FUnparsedEntry;
  536. property Boundary : string read FBoundary write FBoundary;
  537. property ParentPart: integer read FParentPart write FParentPart;
  538. property ImapPartNumber: string read FImapPartNumber write FImapPartNumber;
  539. constructor Create(Collection: TCollection); override;
  540. end;
  541. type
  542. {CC3: Added for validating message number}
  543. EIdNumberInvalid = class(EIdException);
  544. {CCB: Added for server disconnecting you if idle too long...}
  545. EIdDisconnectedProbablyIdledOut = class(EIdException);
  546. TIdImapMessageParts = class(TOwnedCollection)
  547. protected
  548. function GetItem(Index: Integer): TIdImapMessagePart;
  549. procedure SetItem(Index: Integer; const Value: TIdImapMessagePart);
  550. public
  551. function Add: TIdImapMessagePart;
  552. property Items[Index: Integer]: TIdImapMessagePart read GetItem write SetItem; default;
  553. end;
  554. {CCD: Added to parse out responses, because the order in which the responses appear
  555. varies between servers. A typical line that gets parsed into this is:
  556. * 9 FETCH (UID 1234 FLAGS (\Seen \Deleted))
  557. }
  558. TIdIMAPLineStruct = class(TObject)
  559. protected
  560. HasStar: Boolean; //Line starts with a '*'
  561. MessageNumber: string; //Line has a message number (after the *)
  562. Command: string; //IMAP servers send back the command they are responding to, e.g. FETCH
  563. UID: string; //Sometimes the UID is echoed back
  564. Flags: TIdMessageFlagsSet; //Sometimes the FLAGS are echoed back
  565. Complete: Boolean; //If false, line has no closing bracket (response continues on following line(s))
  566. ByteCount: integer; //The value in a trailing byte count like {123}, -1 means not present
  567. IMAPFunction: string; //E.g. FLAGS
  568. IMAPValue: string; //E.g. '(\Seen \Deleted)'
  569. end;
  570. type
  571. TIdIMAP4Commands =
  572. ( cmdCAPABILITY,
  573. cmdNOOP,
  574. cmdLOGOUT,
  575. cmdAUTHENTICATE,
  576. cmdLOGIN,
  577. cmdSELECT,
  578. cmdEXAMINE,
  579. cmdCREATE,
  580. cmdDELETE,
  581. cmdRENAME,
  582. cmdSUBSCRIBE,
  583. cmdUNSUBSCRIBE,
  584. cmdLIST,
  585. cmdLSUB,
  586. cmdSTATUS,
  587. cmdAPPEND,
  588. cmdCHECK,
  589. cmdCLOSE,
  590. cmdEXPUNGE,
  591. cmdSEARCH,
  592. cmdFETCH,
  593. cmdSTORE,
  594. cmdCOPY,
  595. cmdUID,
  596. cmdXCmd );
  597. {CC3: Add csUnexpectedlyDisconnected for when we receive "Connection reset by peer"}
  598. TIdIMAP4ConnectionState = ( csAny, csNonAuthenticated, csAuthenticated, csSelected , csUnexpectedlyDisconnected );
  599. {****************************************************************************
  600. Universal commands CAPABILITY, NOOP, and LOGOUT
  601. Authenticated state commands SELECT, EXAMINE, CREATE, DELETE, RENAME,
  602. SUBSCRIBE, UNSUBSCRIBE, LIST, LSUB, STATUS, and APPEND
  603. Selected state commands CHECK, CLOSE, EXPUNGE, SEARCH, FETCH, STORE, COPY, and UID
  604. *****************************************************************************}
  605. TIdIMAP4SearchKey =
  606. ( skAll, //All messages in the mailbox; the default initial key for ANDing.
  607. skAnswered, //Messages with the \Answered flag set.
  608. skBcc, //Messages that contain the specified string in the envelope structure's BCC field.
  609. skBefore, //Messages whose internal date is earlier than the specified date.
  610. skBody, //Messages that contain the specified string in the body of the message.
  611. skCc, //Messages that contain the specified string in the envelope structure's CC field.
  612. skDeleted, //Messages with the \Deleted flag set.
  613. skDraft, //Messages with the \Draft flag set.
  614. skFlagged, //Messages with the \Flagged flag set.
  615. skFrom, //Messages that contain the specified string in the envelope structure's FROM field.
  616. skHeader, //Messages that have a header with the specified field-name (as defined in [RFC-822])
  617. //and that contains the specified string in the [RFC-822] field-body.
  618. skKeyword, //Messages with the specified keyword set.
  619. skLarger, //Messages with an [RFC-822] size larger than the specified number of octets.
  620. skNew, //Messages that have the \Recent flag set but not the \Seen flag.
  621. //This is functionally equivalent to "(RECENT UNSEEN)".
  622. skNot, //Messages that do not match the specified search key.
  623. skOld, //Messages that do not have the \Recent flag set. This is functionally
  624. //equivalent to "NOT RECENT" (as opposed to "NOT NEW").
  625. skOn, //Messages whose internal date is within the specified date.
  626. skOr, //Messages that match either search key.
  627. skRecent, //Messages that have the \Recent flag set.
  628. skSeen, //Messages that have the \Seen flag set.
  629. skSentBefore,//Messages whose [RFC-822] Date: header is earlier than the specified date.
  630. skSentOn, //Messages whose [RFC-822] Date: header is within the specified date.
  631. skSentSince, //Messages whose [RFC-822] Date: header is within or later than the specified date.
  632. skSince, //Messages whose internal date is within or later than the specified date.
  633. skSmaller, //Messages with an [RFC-822] size smaller than the specified number of octets.
  634. skSubject, //Messages that contain the specified string in the envelope structure's SUBJECT field.
  635. skText, //Messages that contain the specified string in the header or body of the message.
  636. skTo, //Messages that contain the specified string in the envelope structure's TO field.
  637. skUID, //Messages with unique identifiers corresponding to the specified unique identifier set.
  638. skUnanswered,//Messages that do not have the \Answered flag set.
  639. skUndeleted, //Messages that do not have the \Deleted flag set.
  640. skUndraft, //Messages that do not have the \Draft flag set.
  641. skUnflagged, //Messages that do not have the \Flagged flag set.
  642. skUnKeyWord, //Messages that do not have the specified keyword set.
  643. skUnseen );
  644. TIdIMAP4SearchKeyArray = array of TIdIMAP4SearchKey;
  645. TIdIMAP4SearchRec = record
  646. Date: TDateTime;
  647. Size: Integer;
  648. Text: String;
  649. SearchKey : TIdIMAP4SearchKey;
  650. end;
  651. TIdIMAP4SearchRecArray = array of TIdIMAP4SearchRec;
  652. TIdIMAP4StatusDataItem = ( mdMessages, mdRecent, mdUIDNext, mdUIDValidity, mdUnseen );
  653. TIdIMAP4StoreDataItem = ( sdReplace, sdReplaceSilent, sdAdd, sdAddSilent, sdRemove, sdRemoveSilent );
  654. TIdRetrieveOnSelect = ( rsDisabled, rsHeaders, rsMessages );
  655. TIdAlertEvent = procedure(ASender: TObject; const AAlertMsg: String) of object;
  656. TIdIMAP4 = class(TIdMessageClient)
  657. private
  658. procedure SetMailBox(const Value: TIdMailBox);
  659. protected
  660. FCmdCounter : Integer;
  661. FConnectionState : TIdIMAP4ConnectionState;
  662. FMailBox : TIdMailBox;
  663. FMailBoxSeparator: Char;
  664. FOnAlert: TIdAlertEvent;
  665. FRetrieveOnSelect: TIdRetrieveOnSelect;
  666. FMilliSecsToWaitToClearBuffer: integer;
  667. FMUTF7: TIdMUTF7;
  668. FOnWorkForPart: TWorkEvent;
  669. FOnWorkBeginForPart: TWorkBeginEvent;
  670. FOnWorkEndForPart: TWorkEndEvent;
  671. FGreetingBanner : String; {CC7: Added because it may help identify the server}
  672. FHasCapa : Boolean;
  673. {CC7: FSASLMechanisms and FAuthType added when LoginSASL moved from TIdMessageSASLClient to TIdSASLList...}
  674. FSASLMechanisms : TIdSASLEntries;
  675. FAuthType : TIdIMAP4AuthenticationType;
  676. FCapabilities: TIdStringList;
  677. FLineStruct: TIdIMAPLineStruct;
  678. function GetReplyClass:TIdReplyClass; override;
  679. //The following call FMUTF7 but do exception-handling on invalid strings...
  680. function DoMUTFEncode(aString : string):string;
  681. function DoMUTFDecode(aString : string):string;
  682. function GetCmdCounter: String;
  683. function GetConnectionStateName: String;
  684. function GetNewCmdCounter: String;
  685. property LastCmdCounter: String read GetCmdCounter;
  686. property NewCmdCounter: String read GetNewCmdCounter;
  687. { General Functions }
  688. function ArrayToNumberStr (const AMsgNumList: array of Integer): String;
  689. function MessageFlagSetToStr (const AFlags: TIdMessageFlagsSet): String;
  690. //This function is needed because when using the regular DateToStr with dd/MMM/yyyy
  691. //(which is the IMAP needed convension) may give the month as the local language
  692. //three letter month instead of the English month needed.
  693. function DateToIMAPDateStr (const ADate: TDateTime): String;
  694. procedure StripCRLFs(var AText: string); overload; virtual; //Allow users to optimise
  695. procedure StripCRLFs(ASourceStream, ADestStream: TStringStream); overload;
  696. { General Functions }
  697. { Parser Functions }
  698. {CCC: new attempt...}
  699. procedure ParseImapPart(ABodyStructure: string;
  700. AImapParts: TIdImapMessageParts; AThisImapPart: TIdImapMessagePart; AParentImapPart: TIdImapMessagePart;
  701. APartNumber: integer);
  702. procedure ParseMessagePart(ABodyStructure: string;
  703. AMessageParts: TIdMessageParts; AThisMessagePart: TIdMessagePart; AParentMessagePart: TIdMessagePart;
  704. APartNumber: integer);
  705. {CC2: ParseBodyStructureResult added to support individual part retreival...}
  706. procedure ParseBodyStructureResult(ABodyStructure: string; ATheParts: TIdMessageParts; AImapParts: TIdImapMessageParts);
  707. {CC3: ParseBodyStructurePart added to support individual part retreival...}
  708. {CC7: TIdImapSubSection added to ParseBodyStructurePart to support multisection parts...}
  709. procedure ParseBodyStructurePart(APartString: string; AThePart: TIdMessagePart; AImapPart: TIdImapMessagePart{; AImapSubSection: TIdImapSubSection});
  710. procedure ParseTheLine(ALine: string; APartsList: TIdStringList);
  711. procedure ParseIntoParts(APartString: string; AParams: TIdStringList);
  712. procedure ParseIntoBrackettedQuotedAndUnquotedParts(APartString: string; AParams: TIdStringList; AKeepBrackets: Boolean);
  713. procedure BreakApartParamsInQuotes(const AParam: string; var AParsedList: TIdStringList);
  714. function GetNextWord(AParam: string): string;
  715. function GetNextQuotedParam(AParam: string; ARemoveQuotes: Boolean): string;
  716. procedure ParseExpungeResult (AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  717. procedure ParseListResult (AMBList: TIdStringList; ACmdResultDetails: TIdStrings);
  718. procedure ParseLSubResult(AMBList: TIdStringList; ACmdResultDetails: TIdStrings);
  719. {CCA: InternalParseListResult added to resolve NIL mailbox separator and
  720. rationalise code between ParseLisTresult and ParseLSubResult}
  721. procedure InternalParseListResult(ACmd: string; AMBList: TIdStringList; ACmdResultDetails: TIdStrings);
  722. procedure ParseMailBoxAttributeString(AAttributesList: String; var AAttributes: TIdMailBoxAttributesSet);
  723. procedure ParseMessageFlagString (AFlagsList: String; var AFlags: TIdMessageFlagsSet);
  724. procedure ParseSelectResult (AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  725. procedure ParseStatusResult (AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  726. procedure ParseSearchResult (AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  727. procedure ParseEnvelopeResult (AMsg: TIdMessage; ACmdResultStr: String);
  728. function ParseLastCmdResult(ALine: string; AExpectedCommand: string; AExpectedIMAPFunction: array of string): Boolean;
  729. procedure ParseLastCmdResultButAppendInfo(ALine: string);
  730. {CC8: Following added to combine the (UID)Retrieve(Peek) functions...}
  731. function InternalRetrieve(const AMsgNum: Integer; AUseUID: Boolean; AUsePeek: Boolean; ANoDecode: Boolean; AMsg: TIdMessage): Boolean;
  732. {CC2: Following added for retrieving individual parts of a message...}
  733. function InternalRetrievePart(const AMsgNum: Integer; const APartNum: {Integer} string;
  734. AUseUID: Boolean; AUsePeek: Boolean;
  735. {$IFDEF DOTNET}
  736. var ABuffer: TIdBytes;
  737. {$ELSE}
  738. var ABuffer: PChar;
  739. {$ENDIF}
  740. var ABufferLength: Integer; {NOTE: var args cannot have default params}
  741. ADestFileNameAndPath: string = ''; {Do not Localize}
  742. AContentTransferEncoding: string = 'text'): Boolean; {Do not Localize}
  743. function ParseBodyStructureSectionAsEquates(AParam: string): string;
  744. function ParseBodyStructureSectionAsEquates2(AParam: string): string;
  745. {CC3: Following added for retrieving the text-only part of a message...}
  746. function InternalRetrieveText(const AMsgNum: Integer; var AText: string;
  747. AUseUID: Boolean; AUsePeek: Boolean; AUseFirstPartInsteadOfText: Boolean): Boolean;
  748. {CC3: Following added for TLS support..}
  749. function IsCapabilityListed(ACapability: string):Boolean;
  750. {CC6: Added to support RetrieveEnvelopeRaw...}
  751. function InternalRetrieveEnvelope(const AMsgNum: Integer; AMsg: TIdMessage; ADestList: TIdStringList): Boolean;
  752. {CC6: Added to support UIDRetrieveEnvelopeRaw...}
  753. function UIDInternalRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage; ADestList: TIdStringList): Boolean;
  754. {CCD: For getting the header of a part...}
  755. function InternalRetrievePartHeader(const AMsgNum: Integer; const APartNum: string; const AUseUID: Boolean; AHeaders: TIdHeaderList): Boolean;
  756. {CC: ReceiveHeader in IdMessageClient seems to have a very rare bug, maybe it
  757. is missing the end marker occassionally. Moved up to here to add
  758. debugging code, plus it can be converted to an IMAP byte-count retrieval
  759. method if necessary.}
  760. function ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string; override;
  761. {CC3: Need to validate message numbers (relative and UIDs) and part numbers, because otherwise
  762. the routines wait for a response that never arrives and so functions never return.
  763. Also used for validating part numbers.}
  764. function IsNumberValid(const ANumber: Integer): Boolean;
  765. function IsUIDValid(const AUID: string): Boolean;
  766. function IsImapPartNumberValid(const AUID: string): Boolean;
  767. function IsItDigitsAndOptionallyPeriod(const AStr: string; AAllowPeriod: Boolean): Boolean;
  768. {CC6: Override IdMessageClient's ReceiveBody due to the responses from some
  769. servers...}
  770. procedure ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); override; {Do not Localize}
  771. procedure InitComponent; override;
  772. public
  773. { TIdIMAP4 Commands }
  774. //Requests a listing of capabilities that the server supports.
  775. function Capability(ASlCapability: TIdStrings): Boolean; overload;
  776. function FindHowServerCreatesFolders: TIdIMAP4FolderTreatment;
  777. procedure DoAlert (const AMsg: String);
  778. property ConnectionState: TIdIMAP4ConnectionState read FConnectionState;
  779. property MailBox: TIdMailBox read FMailBox write SetMailBox;
  780. {CC7: Two versions of AppendMsg are provided. The first is the normal one you
  781. would use. The second allows you to specify an alternative header list which
  782. will be used in place of AMsg.Headers.
  783. An email client may need the second type if it sends an email via IdSMTP and wants
  784. to copy it to a "Sent" IMAP folder. In Indy 9, IdSMTP internally generates and
  785. transmits the headers but does not keep them, so what you may need to do is to
  786. subclass IdSMTP, override SendHeader so that the TIdHeaderList is returned (and
  787. also override both SendMsg and Send to get it back to you), then use the
  788. second version of AppendMsg to use the returned TIdHeaderList. In Indy 10,
  789. IdSMTP puts the generated headers in the LastGeneratedHeaders field, so you
  790. can use the second version of AppendMsg, passing it AMsg.LastGeneratedHeaders as
  791. the AAlternativeHeaders field. Note that IdSMTP puts both the Headers and
  792. the ExtraHeaders fields in LastGeneratedHeaders.}
  793. function AppendMsg (const AMBName: String; AMsg: TIdMessage; const AFlags: TIdMessageFlagsSet = []): Boolean; overload;
  794. function AppendMsg (const AMBName: String; AMsg: TIdMessage; AAlternativeHeaders: TIdHeaderList; const AFlags: TIdMessageFlagsSet = []): Boolean; overload;
  795. function AppendMsgNoEncodeFromFile (const AMBName: String; ASourceFile: string; const AFlags: TIdMessageFlagsSet = []): Boolean;
  796. function AppendMsgNoEncodeFromStream (const AMBName: String; AStream: TStream; const AFlags: TIdMessageFlagsSet = []): Boolean;
  797. //The following are used for raw (unparsed) messages in a file or stream...
  798. //Requests a checkpoint of the currently selected mailbox. Does NOTHING on most servers.
  799. function CheckMailBox: Boolean;
  800. //Checks if the message was read or not.
  801. function CheckMsgSeen (const AMsgNum: Integer): Boolean;
  802. //Method for logging in manually if you didn't login at connect
  803. procedure Login; virtual;
  804. //Connects and logins to the IMAP4 account.
  805. procedure Connect(const AAndLogin: boolean = true); reintroduce; virtual;
  806. //Closes the current selected mailbox in the account. {Do not Localize}
  807. function CloseMailBox: Boolean;
  808. //Creates a new mailbox with the specified name in the account. {Do not Localize}
  809. function CreateMailBox (const AMBName: String): Boolean;
  810. //Deletes the specified mailbox from the account. {Do not Localize}
  811. function DeleteMailBox (const AMBName: String): Boolean;
  812. //Marks messages for deletion, it will be deleted when the mailbox will be purged.
  813. function DeleteMsgs(const AMsgNumList: array of Integer): Boolean;
  814. destructor Destroy; override;
  815. //Logouts and disconnects from the IMAP account.
  816. procedure Disconnect; overload;
  817. //Disconnect with a parameter for raising a Not Connected exception
  818. procedure Disconnect(AImmediate: Boolean; const ARaiseExceptionIfNotCon : Boolean); reintroduce; overload;
  819. //Examines the specified mailbox and inserts the results to the TIdMailBox provided. {Do not Localize}
  820. function ExamineMailBox (const AMBName: String; AMB: TIdMailBox): Boolean;
  821. //Expunges (deletes the marked files) the current selected mailbox in the account. {Do not Localize}
  822. function ExpungeMailBox: Boolean;
  823. //Sends a NOOP (No Operation) to keep the account connection with the server alive.
  824. procedure KeepAlive;
  825. //Returns a list of all the child mailboxes (one level down) to the mailbox supplied.
  826. //This should be used when you fear that there are too many mailboxes and the listing of
  827. //all of them could be time consuming, so this should be used to retrieve specific mailboxes.
  828. function ListInferiorMailBoxes (AMailBoxList, AInferiorMailBoxList: TIdStringList): Boolean;
  829. //Returns a list of all the mailboxes in the user account.
  830. function ListMailBoxes (AMailBoxList: TIdStringList): Boolean;
  831. //Returns a list of all the subscribed mailboxes in the user account.
  832. function ListSubscribedMailBoxes (AMailBoxList: TIdStringList): Boolean;
  833. //Renames the specified mailbox in the account. {Do not Localize}
  834. function RenameMailBox (const AOldMBName, ANewMBName: String): Boolean;
  835. //Searches the current selected mailbox for messages matching the SearchRec and
  836. //returnes the results to the mailbox SearchResults array.
  837. function SearchMailBox (const ASearchInfo: array of TIdIMAP4SearchRec): Boolean;
  838. //Selects the current a mailbox in the account. {Do not Localize}
  839. function SelectMailBox (const AMBName: String): Boolean;
  840. //Retrieves the status of the indicated mailbox.
  841. {CC2: It is pointless calling StatusMailBox with AStatusDataItems set to []
  842. because you are asking the IMAP server to update none of the status flags.
  843. Instead, if called with no AStatusDataItems specified, use the standard flags
  844. returned by SelectMailBox, which allows the user to easily check if the mailbox
  845. has changed. Overload the functions, since AStatusDataItems cannot be set
  846. to nil.}
  847. function StatusMailBox (const AMBName: String; AMB: TIdMailBox): Boolean; overload;
  848. function StatusMailBox (const AMBName: String; AMB: TIdMailBox; const AStatusDataItems: array of TIdIMAP4StatusDataItem): Boolean; overload;
  849. //Changes (adds or removes) message flags.
  850. function StoreFlags (const AMsgNumList: array of Integer;
  851. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  852. //Adds the specified mailbox name to the server's set of "active" or "subscribed" {Do not Localize}
  853. //mailboxes as returned by the LSUB command.
  854. function SubscribeMailBox (const AMBName: String): Boolean;
  855. {CC8: Added CopyMsg, should have always been there...}
  856. function CopyMsg (const AMsgNum: Integer; const AMBName: String): Boolean;
  857. //Copies a message from the current selected mailbox to the specified mailbox. {Do not Localize}
  858. function CopyMsgs (const AMsgNumList: array of Integer; const AMBName: String): Boolean;
  859. //Retrieves a whole message while marking it read.
  860. function Retrieve (const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  861. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  862. function RetrieveNoDecodeToFile (const AMsgNum: Integer; ADestFile: string): Boolean;
  863. function RetrieveNoDecodeToStream (const AMsgNum: Integer; AStream: TStream): Boolean;
  864. //Retrieves all envelope of the selected mailbox to the specified TIdMessageCollection.
  865. function RetrieveAllEnvelopes (AMsgList: TIdMessageCollection): Boolean;
  866. //Retrieves all headers of the selected mailbox to the specified TIdMessageCollection.
  867. function RetrieveAllHeaders (AMsgList: TIdMessageCollection): Boolean;
  868. //Retrieves all messages of the selected mailbox to the specified TIdMessageCollection.
  869. function RetrieveAllMsgs (AMsgList: TIdMessageCollection): Boolean;
  870. //Retrieves the message envelope, parses it, and discards the envelope.
  871. function RetrieveEnvelope (const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  872. //Retrieves the message envelope into a TIdStringList but does NOT parse it.
  873. function RetrieveEnvelopeRaw(const AMsgNum: Integer; ADestList: TIdStringList): Boolean;
  874. //Returnes the message flag values.
  875. function RetrieveFlags (const AMsgNum: Integer; var AFlags: TIdMessageFlagsSet): Boolean;
  876. {CC2: Following added for retrieving individual parts of a message...}
  877. function InternalRetrieveStructure(const AMsgNum: Integer; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  878. //Retrieve only the message structure (this tells you what parts are in the message).
  879. function RetrieveStructure(const AMsgNum: Integer; AMsg: TIdMessage): Boolean; overload;
  880. function RetrieveStructure(const AMsgNum: Integer; AParts: TIdImapMessageParts): Boolean; overload;
  881. {CC2: Following added for retrieving individual parts of a message...}
  882. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  883. function RetrievePart(const AMsgNum: Integer; const APartNum: Integer;
  884. {$IFDEF DOTNET}
  885. var ABuffer: TIdBytes;
  886. {$ELSE}
  887. var ABuffer: PChar;
  888. {$ENDIF}
  889. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  890. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  891. function RetrievePart(const AMsgNum: Integer; const APartNum: string;
  892. {$IFDEF DOTNET}
  893. var ABuffer: TIdBytes;
  894. {$ELSE}
  895. var ABuffer: PChar;
  896. {$ENDIF}
  897. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  898. {CC2: Following added for retrieving individual parts of a message...}
  899. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  900. function RetrievePartPeek(const AMsgNum: Integer; const APartNum: Integer;
  901. {$IFDEF DOTNET}
  902. var ABuffer: TIdBytes;
  903. {$ELSE}
  904. var ABuffer: PChar;
  905. {$ENDIF}
  906. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  907. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  908. function RetrievePartPeek(const AMsgNum: Integer; const APartNum: string;
  909. {$IFDEF DOTNET}
  910. var ABuffer: TIdBytes;
  911. {$ELSE}
  912. var ABuffer: PChar;
  913. {$ENDIF}
  914. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  915. {CC2: Following added for retrieving individual parts of a message...}
  916. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  917. function RetrievePartToFile(const AMsgNum: Integer; const APartNum: Integer;
  918. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  919. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  920. function RetrievePartToFile(const AMsgNum: Integer; const APartNum: string;
  921. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  922. {CC2: Following added for retrieving individual parts of a message...}
  923. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  924. function RetrievePartToFilePeek(const AMsgNum: Integer; const APartNum: Integer;
  925. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  926. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  927. function RetrievePartToFilePeek(const AMsgNum: Integer; const APartNum: string;
  928. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  929. {CC3: Following added for retrieving the text-only part of a message...}
  930. function RetrieveText(const AMsgNum: Integer; var AText: string): Boolean;
  931. {CC4: An alternative for retrieving the text-only part of a message which
  932. may give a better response from some IMAP implementations...}
  933. function RetrieveText2(const AMsgNum: Integer; var AText: string): Boolean;
  934. {CC3: Following added for retrieving the text-only part of a message...}
  935. function RetrieveTextPeek(const AMsgNum: Integer; var AText: string): Boolean;
  936. function RetrieveTextPeek2(const AMsgNum: Integer; var AText: string): Boolean;
  937. //Retrieves only the message header.
  938. function RetrieveHeader (const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  939. //CCD: Retrieve the header for a particular part...
  940. function RetrievePartHeader(const AMsgNum: Integer; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  941. //Retrives the current selected mailbox size.
  942. function RetrieveMailBoxSize: Integer;
  943. //Returnes the message size.
  944. function RetrieveMsgSize(const AMsgNum: Integer): Integer;
  945. //Retrieves a whole message while keeping its Seen flag untucked {Do not Localize}
  946. //(preserving the previous value).
  947. function RetrievePeek (const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  948. //Get the UID corresponding to a relative message number.
  949. function GetUID(const AMsgNum: Integer; var AUID: string): Boolean;
  950. //Copies a message from the current selected mailbox to the specified mailbox. {Do not Localize}
  951. function UIDCopyMsg (const AMsgUID: String; const AMBName: String): Boolean;
  952. {CC8: Added UID version of CopyMsgs...}
  953. function UIDCopyMsgs(const AMsgUIDList: TIdStringList; const AMBName: String): Boolean;
  954. //Checks if the message was read or not.
  955. function UIDCheckMsgSeen (const AMsgUID: String): Boolean;
  956. //Marks a message for deletion, it will be deleted when the mailbox will be purged.
  957. function UIDDeleteMsg(const AMsgUID: String): Boolean;
  958. function UIDDeleteMsgs(const AMsgUIDList: array of String): Boolean;
  959. //Retrieves all headers of the selected mailbox to the specified TIdMessageCollection.
  960. {CC5: This is not, and never was, implemented: why would you use it?}
  961. {CC8: UIDRetrieveAllHeaders is removed, it makes no sense when you think about it,
  962. because it would need a sparse array because of missing UIDs in sequence.}
  963. {function UIDRetrieveAllHeaders (AMsgList: TIdMessageCollection): Boolean;}
  964. //Retrieves all envelope and UID of the selected mailbox to the specified TIdMessageCollection.
  965. function UIDRetrieveAllEnvelopes (AMsgList: TIdMessageCollection): Boolean;
  966. //Retrieves a whole message while marking it read.
  967. function UIDRetrieve (const AMsgUID: String; AMsg: TIdMessage): Boolean;
  968. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  969. function UIDRetrieveNoDecodeToFile (const AMsgUID: String; ADestFile: string): Boolean;
  970. function UIDRetrieveNoDecodeToStream (const AMsgUID: String; AStream: TStream): Boolean;
  971. //Retrieves the message envelope, parses it, and discards the envelope.
  972. function UIDRetrieveEnvelope (const AMsgUID: String; AMsg: TIdMessage): Boolean;
  973. //Retrieves the message envelope into a TIdStringList but does NOT parse it.
  974. function UIDRetrieveEnvelopeRaw(const AMsgUID: String; ADestList: TIdStringList): Boolean;
  975. //Returnes the message flag values.
  976. function UIDRetrieveFlags (const AMsgUID: String; var AFlags: TIdMessageFlagsSet): Boolean;
  977. {CC2: Following added for retrieving individual parts of a message...}
  978. function UIDInternalRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  979. //Retrieve only the message structure (this tells you what parts are in the message).
  980. function UIDRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage): Boolean; overload;
  981. function UIDRetrieveStructure(const AMsgUID: String; AParts: TIdImapMessageParts): Boolean; overload;
  982. {CC2: Following added for retrieving individual parts of a message...}
  983. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  984. function UIDRetrievePart(const AMsgUID: String; const APartNum: Integer;
  985. {$IFDEF DOTNET}
  986. var ABuffer: TIdBytes;
  987. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  988. {$ELSE}
  989. var ABuffer: PChar;
  990. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  991. {$ENDIF}
  992. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  993. function UIDRetrievePart(const AMsgUID: String; const APartNum: string;
  994. {$IFDEF DOTNET}
  995. var ABuffer: TIdBytes;
  996. {$ELSE}
  997. var ABuffer: PChar;
  998. {$ENDIF}
  999. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  1000. {CC2: Following added for retrieving individual parts of a message...}
  1001. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  1002. function UIDRetrievePartPeek(const AMsgUID: String; const APartNum: Integer;
  1003. {$IFDEF DOTNET}
  1004. var ABuffer: TIdBytes;
  1005. {$ELSE}
  1006. var ABuffer: PChar;
  1007. {$ENDIF}
  1008. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  1009. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  1010. function UIDRetrievePartPeek(const AMsgUID: String; const APartNum: string;
  1011. {$IFDEF DOTNET}
  1012. var ABuffer: TIdBytes;
  1013. {$ELSE}
  1014. var ABuffer: PChar;
  1015. {$ENDIF}
  1016. var ABufferLength: Integer; AContentTransferEncoding: string = 'text'): Boolean; overload; {Do not Localize}
  1017. {CC2: Following added for retrieving individual parts and subparts of a message...}
  1018. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  1019. function UIDRetrievePartToFile(const AMsgUID: String; const APartNum: Integer;
  1020. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  1021. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  1022. function UIDRetrievePartToFile(const AMsgUID: String; const APartNum: string;
  1023. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  1024. {CC2: Following added for retrieving individual parts of a message...}
  1025. {Retrieve a specific individual part of a message where part is an integer (for backward compatibility)...}
  1026. function UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: Integer;
  1027. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  1028. {Retrieve a specific individual part of a message where part is an integer or sub-part like '2.3'...}
  1029. function UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: string;
  1030. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean; overload;
  1031. {CC3: Following added for retrieving the text-only part of a message...}
  1032. function UIDRetrieveText(const AMsgUID: String; var AText: string): Boolean;
  1033. function UIDRetrieveText2(const AMsgUID: String; var AText: string): Boolean;
  1034. {CC3: Following added for retrieving the text-only part of a message...}
  1035. function UIDRetrieveTextPeek(const AMsgUID: String; var AText: string): Boolean;
  1036. function UIDRetrieveTextPeek2(const AMsgUID: String; var AText: string): Boolean;
  1037. //Retrieves only the message header.
  1038. function UIDRetrieveHeader (const AMsgUID: String; AMsg: TIdMessage): Boolean;
  1039. //CCD: Retrieve the header for a particular part...
  1040. function UIDRetrievePartHeader(const AMsgUID: String; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  1041. //Retrives the current selected mailbox size.
  1042. function UIDRetrieveMailBoxSize: Integer;
  1043. //Returnes the message size.
  1044. function UIDRetrieveMsgSize(const AMsgUID: String): Integer;
  1045. //Retrieves a whole message while keeping its Seen flag untucked {Do not Localize}
  1046. //(preserving the previous value).
  1047. function UIDRetrievePeek (const AMsgUID: String; AMsg: TIdMessage): Boolean;
  1048. //Searches the current selected mailbox for messages matching the SearchRec and
  1049. //returnes the results as UIDs to the mailbox SearchResults array.
  1050. function UIDSearchMailBox (const ASearchInfo: array of TIdIMAP4SearchRec{Array}): Boolean;//array of TIdIMAP4SearchRec ) : Boolean;
  1051. //Changes (adds or removes) message flags.
  1052. function UIDStoreFlags (const AMsgUID: String; const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean; overload;
  1053. function UIDStoreFlags (const AMsgUIDList: array of String; const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean; overload;
  1054. //Removes the specified mailbox name from the server's set of "active" or "subscribed" {Do not Localize}
  1055. //mailboxes as returned by the LSUB command.
  1056. function UnsubscribeMailBox (const AMBName: String): Boolean;
  1057. { TIdIMAP4 Commands }
  1058. { IdTCPConnection Commands }
  1059. function GetInternalResponse (const ATag: String; AExpectedResponses: array of String; ASingleLineMode: Boolean; ASingleLineMayBeSplit: Boolean = False): string; reintroduce; overload;
  1060. function GetResponse: string; reintroduce; overload;
  1061. function SendCmd(const AOut: string; AExpectedResponses: array of String): string; overload; //overload; override;
  1062. function SendCmd(const ATag, AOut: string; AExpectedResponses: array of String): string; overload; //reintroduce; overload;
  1063. function ReadLnWait: string;
  1064. procedure WriteLn(AOut: string);
  1065. { IdTCPConnection Commands }
  1066. published
  1067. property OnAlert: TIdAlertEvent read FOnAlert write FOnAlert;
  1068. property Password;
  1069. property RetrieveOnSelect: TIdRetrieveOnSelect read FRetrieveOnSelect write FRetrieveOnSelect default rsDisabled;
  1070. property Port default IdPORT_IMAP4;
  1071. property Username;
  1072. property MailBoxSeparator: Char read FMailBoxSeparator write FMailBoxSeparator default '/'; {Do not Localize}
  1073. {CC7: GreetingBanner added because it may help identify the server...}
  1074. property GreetingBanner : string read FGreetingBanner;
  1075. property Host;
  1076. property UseTLS;
  1077. {CC7: AuthenticationType removed, SASLMechanisms and AuthType added when
  1078. LoginSASL moved from TIdMessageSASLClient to TIdSASLList}
  1079. property SASLMechanisms : TIdSASLEntries read FSASLMechanisms write FSASLMechanisms;
  1080. property AuthType : TIdIMAP4AuthenticationType read FAuthType write FAuthType default DEF_IMAP4_AUTH;
  1081. property MilliSecsToWaitToClearBuffer: integer read FMilliSecsToWaitToClearBuffer write FMilliSecsToWaitToClearBuffer;
  1082. {The following is the OnWork property for use when retrieving PARTS of a message.
  1083. It is also used for AppendMsg and Retrieve. The reason is that all those methods
  1084. dynamically create a TIdTCPStream to do the byte-count transfer.
  1085. This is in addition to the normal OnWork property, which is exposed by TIdIMAP4, but
  1086. which is only activated during IMAP sending & receiving of commands (subject
  1087. to the general OnWork caveats, i.e. it is only called during certain methods,
  1088. note OnWork[Begin][End] are all only called in the methods AllData(),
  1089. PerformCapture() and Read/WriteStream() ).
  1090. When a PART of a message is processed, a TIdTCPStream is opened, and this exposes
  1091. that stream's OnWork property. Use this for progress notification of retrieval
  1092. of IMAP parts, such as retrieving attachments. OnWorkBegin and OnWorkEnd are not
  1093. exposed, because they won't be activated during the processing of a part.}
  1094. property OnWorkForPart: TWorkEvent read FOnWorkForPart write FOnWorkForPart;
  1095. property OnWorkBeginForPart: TWorkBeginEvent read FOnWorkBeginForPart write FOnWorkBeginForPart;
  1096. property OnWorkEndForPart: TWorkEndEvent read FOnWorkEndForPart write FOnWorkEndForPart;
  1097. end;
  1098. implementation
  1099. uses
  1100. IdEMailAddress,
  1101. IdResourceStrings,
  1102. IdExplicitTLSClientServerBase, {Indy 10 SSL support - framework supports DotNET}
  1103. SysUtils, {CC3: SysUtils added to support Exception}
  1104. IdGlobalProtocols,
  1105. IdExceptionCore,
  1106. IdStack,
  1107. IdTCPStream,
  1108. IdText,
  1109. IdAttachment,
  1110. IdResourceStringsProtocols,
  1111. IdStreamVCL,
  1112. {$IFDEF DOTNET}
  1113. IdBuffer,
  1114. {$ENDIF}
  1115. IdAttachmentMemory,
  1116. IdReplyIMAP4, {CC6: for Indy 10 changes}
  1117. IdTCPConnection;
  1118. type
  1119. TIdIMAP4FetchDataItem =
  1120. ( fdAll, //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE)
  1121. fdBody, //Non-extensible form of BODYSTRUCTURE.
  1122. fdBodyExtensible,
  1123. fdBodyPeek,
  1124. fdBodyStructure, //The [MIME-IMB] body structure of the message. This
  1125. //is computed by the server by parsing the [MIME-IMB]
  1126. //header fields in the [RFC-822] header and [MIME-IMB] headers.
  1127. fdEnvelope, //The envelope structure of the message. This is
  1128. //computed by the server by parsing the [RFC-822]
  1129. //header into the component parts, defaulting various
  1130. //fields as necessary.
  1131. fdFast, //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE)
  1132. fdFlags, //The flags that are set for this message.
  1133. fdFull, //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODY)
  1134. fdInternalDate, //The internal date of the message.
  1135. fdRFC822, //Functionally equivalent to BODY[], differing in the
  1136. //syntax of the resulting untagged FETCH data (RFC822
  1137. //is returned).
  1138. fdRFC822Header, //Functionally equivalent to BODY.PEEK[HEADER],
  1139. //differing in the syntax of the resulting untagged
  1140. //FETCH data (RFC822.HEADER is returned).
  1141. fdRFC822Size, //The [RFC-822] size of the message.
  1142. fdRFC822Text, //Functionally equivalent to BODY[TEXT], differing in
  1143. //the syntax of the resulting untagged FETCH data
  1144. //(RFC822.TEXT is returned).
  1145. fdHeader, //CC: Added to get the header of a part
  1146. fdUID ); //The unique identifier for the message.
  1147. const
  1148. IMAP4Commands : array [cmdCapability..cmdXCmd] of String =
  1149. (
  1150. { Client Commands - Any State}
  1151. 'CAPABILITY', {Do not Localize}
  1152. 'NOOP', {Do not Localize}
  1153. 'LOGOUT', {Do not Localize}
  1154. { Client Commands - Non Authenticated State}
  1155. 'AUTHENTICATE', {Do not Localize}
  1156. 'LOGIN', {Do not Localize}
  1157. { Client Commands - Authenticated State}
  1158. 'SELECT', {Do not Localize}
  1159. 'EXAMINE', {Do not Localize}
  1160. 'CREATE', {Do not Localize}
  1161. 'DELETE', {Do not Localize}
  1162. 'RENAME', {Do not Localize}
  1163. 'SUBSCRIBE', {Do not Localize}
  1164. 'UNSUBSCRIBE', {Do not Localize}
  1165. 'LIST', {Do not Localize}
  1166. 'LSUB', {Do not Localize}
  1167. 'STATUS', {Do not Localize}
  1168. 'APPEND', {Do not Localize}
  1169. { Client Commands - Selected State}
  1170. 'CHECK', {Do not Localize}
  1171. 'CLOSE', {Do not Localize}
  1172. 'EXPUNGE', {Do not Localize}
  1173. 'SEARCH', {Do not Localize}
  1174. 'FETCH', {Do not Localize}
  1175. 'STORE', {Do not Localize}
  1176. 'COPY', {Do not Localize}
  1177. 'UID', {Do not Localize}
  1178. { Client Commands - Experimental/ Expansion}
  1179. 'X' {Do not Localize}
  1180. );
  1181. IMAP4FetchDataItem : array [fdAll..fdUID] of String =
  1182. ( 'ALL', {Do not Localize} //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE)
  1183. 'BODY', {Do not Localize} //Non-extensible form of BODYSTRUCTURE.
  1184. 'BODY[%s]<%s>', {Do not Localize}
  1185. 'BODY.PEEK[]', {Do not Localize}
  1186. 'BODYSTRUCTURE', {Do not Localize} //The [MIME-IMB] body structure of the message. This
  1187. //is computed by the server by parsing the [MIME-IMB]
  1188. //header fields in the [RFC-822] header and [MIME-IMB] headers.
  1189. 'ENVELOPE', {Do not Localize} //The envelope structure of the message. This is
  1190. //computed by the server by parsing the [RFC-822]
  1191. //header into the component parts, defaulting various
  1192. //fields as necessary.
  1193. 'FAST', {Do not Localize} //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE)
  1194. 'FLAGS', {Do not Localize} //The flags that are set for this message.
  1195. 'FULL', {Do not Localize} //Macro equivalent to: (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODY)
  1196. 'INTERNALDATE', {Do not Localize} //The internal date of the message.
  1197. 'RFC822', {Do not Localize} //Functionally equivalent to BODY[], differing in the
  1198. //syntax of the resulting untagged FETCH data (RFC822
  1199. //is returned).
  1200. 'RFC822.HEADER', {Do not Localize} //Functionally equivalent to BODY.PEEK[HEADER],
  1201. //differing in the syntax of the resulting untagged
  1202. //FETCH data (RFC822.HEADER is returned).
  1203. 'RFC822.SIZE', {Do not Localize} //The [RFC-822] size of the message.
  1204. 'RFC822.TEXT', {Do not Localize} //Functionally equivalent to BODY[TEXT], differing in
  1205. //the syntax of the resulting untagged FETCH data
  1206. //(RFC822.TEXT is returned).
  1207. 'HEADER', {Do not Localize} //CC: Added to get the header of a part
  1208. 'UID' ); {Do not Localize} //The unique identifier for the message.
  1209. IMAP4SearchKeys : array [skAll..skUnseen] of String =
  1210. ( 'ALL', {Do not Localize} //All messages in the mailbox; the default initial key for ANDing.
  1211. 'ANSWERED', {Do not Localize} //Messages with the \Answered flag set.
  1212. 'BCC', {Do not Localize} //Messages that contain the specified string in the envelope structure's BCC field.
  1213. 'BEFORE', {Do not Localize} //Messages whose internal date is earlier than the specified date.
  1214. 'BODY', {Do not Localize} //Messages that contain the specified string in the body of the message.
  1215. 'CC', {Do not Localize} //Messages that contain the specified string in the envelope structure's CC field.
  1216. 'DELETED', {Do not Localize} //Messages with the \Deleted flag set.
  1217. 'DRAFT', {Do not Localize} //Messages with the \Draft flag set.
  1218. 'FLAGGED', {Do not Localize} //Messages with the \Flagged flag set.
  1219. 'FROM', {Do not Localize} //Messages that contain the specified string in the envelope structure's FROM field.
  1220. 'HEADER', {Do not Localize} //Messages that have a header with the specified field-name (as defined in [RFC-822])
  1221. //and that contains the specified string in the [RFC-822] field-body.
  1222. 'KEYWORD', {Do not Localize} //Messages with the specified keyword set.
  1223. 'LARGER', {Do not Localize} //Messages with an [RFC-822] size larger than the specified number of octets.
  1224. 'NEW', {Do not Localize} //Messages that have the \Recent flag set but not the \Seen flag.
  1225. //This is functionally equivalent to "(RECENT UNSEEN)".
  1226. 'NOT', {Do not Localize} //Messages that do not match the specified search key.
  1227. 'OLD', {Do not Localize} //Messages that do not have the \Recent flag set. This is functionally
  1228. //equivalent to "NOT RECENT" (as opposed to "NOT NEW").
  1229. 'ON', {Do not Localize} //Messages whose internal date is within the specified date.
  1230. 'OR', {Do not Localize} //Messages that match either search key.
  1231. 'RECENT', {Do not Localize} //Messages that have the \Recent flag set.
  1232. 'SEEN', {Do not Localize} //Messages that have the \Seen flag set.
  1233. 'SENTBEFORE', {Do not Localize} //Messages whose [RFC-822] Date: header is earlier than the specified date.
  1234. 'SENTON', {Do not Localize} //Messages whose [RFC-822] Date: header is within the specified date.
  1235. 'SENTSINCE', {Do not Localize} //Messages whose [RFC-822] Date: header is within or later than the specified date.
  1236. 'SINCE', {Do not Localize} //Messages whose internal date is within or later than the specified date.
  1237. 'SMALLER', {Do not Localize} //Messages with an [RFC-822] size smaller than the specified number of octets.
  1238. 'SUBJECT', {Do not Localize} //Messages that contain the specified string in the envelope structure's SUBJECT field.
  1239. 'TEXT', {Do not Localize} //Messages that contain the specified string in the header or body of the message.
  1240. 'TO', {Do not Localize} //Messages that contain the specified string in the envelope structure's TO field.
  1241. 'UID', {Do not Localize} //Messages with unique identifiers corresponding to the specified unique identifier set.
  1242. 'UNANSWERED', {Do not Localize} //Messages that do not have the \Answered flag set.
  1243. 'UNDELETED', {Do not Localize} //Messages that do not have the \Deleted flag set.
  1244. 'UNDRAFT', {Do not Localize} //Messages that do not have the \Draft flag set.
  1245. 'UNFLAGGED', {Do not Localize} //Messages that do not have the \Flagged flag set.
  1246. 'UNKEYWORD', {Do not Localize} //Messages that do not have the specified keyword set.
  1247. 'UNSEEN' ); {Do not Localize}
  1248. IMAP4StoreDataItem : array [sdReplace..sdRemoveSilent] of String =
  1249. ( 'FLAGS', {Do not Localize}
  1250. 'FLAGS.SILENT', {Do not Localize}
  1251. '+FLAGS', {Do not Localize}
  1252. '+FLAGS.SILENT', {Do not Localize}
  1253. '-FLAGS', {Do not Localize}
  1254. '-FLAGS.SILENT' ); {Do not Localize}
  1255. IMAP4StatusDataItem : array [mdMessages..mdUnseen] of String =
  1256. ( 'MESSAGES', {Do not Localize}
  1257. 'RECENT', {Do not Localize}
  1258. 'UIDNEXT', {Do not Localize}
  1259. 'UIDVALIDITY', {Do not Localize}
  1260. 'UNSEEN' ); {Do not Localize}
  1261. { TIdEMUTF7 }
  1262. function TIdMUTF7.Encode(aString : string):string;
  1263. { -- MUTF7Encode -------------------------------------------------------------
  1264. PRE: nothing
  1265. POST: returns a string encoded as described in IETF RFC 3501, section 5.1.3
  1266. based upon RFC 2152
  1267. 2004-03-02 roman puls: speed improvements of around 2000 percent due to
  1268. replacement of pchar/while loops to delphi-style string/for
  1269. loops. Minor changes for '&' handling. Delphi 8 compatible.
  1270. 2004-02-29 roman puls: initial version ---}
  1271. var
  1272. c : byte;
  1273. bitbuf : Cardinal;
  1274. bitShift : integer;
  1275. x : integer;
  1276. escaped : boolean;
  1277. begin
  1278. result := '';
  1279. escaped := false;
  1280. bitShift := 0;
  1281. bitbuf := 0;
  1282. for x := 1 to length(aString) do begin
  1283. c := byte(aString[x]);
  1284. // c must be < 128 _and_ in table b64table
  1285. if (c <= $7f) and (b64Table[c] <> $ff) or (aString[x] = '&') then begin // we can directly encode that char
  1286. if escaped then begin
  1287. if (bitShift > 0) then begin // flush bitbuffer if needed
  1288. result := result +
  1289. char(byte(b64Chars[bitbuf shl (6 - bitShift) and $3f]));
  1290. end;
  1291. result := result + '-'; // leave escape sequence
  1292. escaped := false;
  1293. end;
  1294. if (aString[x] = '&') then begin // escape special char "&"
  1295. escaped := false;
  1296. result := result + '&-';
  1297. end else begin
  1298. result := result + char(c); // store direct translated char
  1299. end;
  1300. end else begin
  1301. if not escaped then begin
  1302. result := result + '&';
  1303. escaped := true;
  1304. bitShift := 0;
  1305. end;
  1306. bitbuf := bitbuf shl 16; // shift
  1307. bitBuf := bitBuf or c; // and store new bye
  1308. inc(bitShift, 16);
  1309. while (bitShift >= 6) do begin // flush buffer as far as we can
  1310. dec(bitShift, 6);
  1311. result := result + char(byte(b64Chars[(bitbuf shr bitShift) and $3f]));
  1312. end;
  1313. end;
  1314. end;
  1315. // we love duplicate work but must test for flush buffers for the price
  1316. // of speed (loop)
  1317. if escaped then begin
  1318. if (bitShift > 0) then begin
  1319. result := result + char(byte(b64Chars[bitbuf shl (6 - bitShift) and $3f]));
  1320. end;
  1321. result := result + '-';
  1322. end;
  1323. end;
  1324. function TIdMUTF7.Decode(aString : string):string;
  1325. { -- mUTF7Decode -------------------------------------------------------------
  1326. PRE: aString encoding must conform to IETF RFC 3501, section 5.1.3
  1327. POST: SUCCESS: an 8bit string
  1328. FAILURE: an exception of type EMUTF7Decode
  1329. 2004-03-02 roman puls: speed improvements of around 400 percent due to
  1330. replacement of pchar/while loops to delphi-style string/for
  1331. loops. Delphi 8 compatible.
  1332. 2004-02-29 roman puls: initial version ---}
  1333. var
  1334. ch : word;
  1335. c : byte;
  1336. last : char;
  1337. bitBuf : word;
  1338. escaped : boolean;
  1339. x,
  1340. bitShift: integer;
  1341. begin
  1342. result := '';
  1343. escaped := false;
  1344. bitShift := 0;
  1345. last := #0;
  1346. bitBuf := 0;
  1347. for x := 1 to length(aString) do begin
  1348. ch := byte(aString[x]);
  1349. if not escaped then begin
  1350. if (aString[x] = '&') then begin // escape sequence found
  1351. escaped := true;
  1352. bitBuf := 0;
  1353. bitShift := 10;
  1354. last := '&';
  1355. end else begin
  1356. if (ch < $80) and (b64Table[ch] <> $ff) then begin
  1357. result := result + aString[x];
  1358. end else begin
  1359. raise EMUTF7Decode.createFmt('Illegal char #%d in UTF7 sequence.', {do not localize}
  1360. [ch]);
  1361. end;
  1362. end;
  1363. end else begin // we're escaped
  1364. { break out of escape mode }
  1365. if (astring[x] = '-') then begin
  1366. // extra check for pending bits
  1367. escaped := false;
  1368. if (last = '&') then begin // special sequence '&-' ?
  1369. result := result + '&';
  1370. end else begin
  1371. if ((bitBuf or bitShift) < 6) then begin // check for bitboundaries
  1372. raise EMUTF7Decode.Create('Illegal bit shifting in MUTF7 string'); {do not localize}
  1373. end;
  1374. end;
  1375. end else begin // escaped
  1376. // check range for ch: must be < 128 and in b64table
  1377. if (ch >= $80) or (b64Index[ch] = -1) then begin
  1378. raise EMUTF7Decode.createFmt('Illegal char #%d in UTF7 sequence.', [ch]); {do not localize}
  1379. end;
  1380. ch := b64Index[ch];
  1381. if (bitShift > 0) then begin
  1382. bitbuf := bitBuf or (ch shl bitShift);
  1383. dec(bitShift, 6);
  1384. end else begin
  1385. bitbuf := bitBuf or (ch shr -bitShift);
  1386. c := byte(bitBuf);
  1387. // us ASCII in encoded string?
  1388. if (c >= $20) and (c < $7f) then begin // what is with '&'? -> not allowed!
  1389. // must be encoded "&-"
  1390. raise EMUTF7Decode.createFmt('US-ASCII char #%d in UTF7 sequence.', {do not localize}
  1391. [c]);
  1392. end;
  1393. result := result + char(c);
  1394. bitBuf := (ch shl (16 + bitShift)) and $ffff;
  1395. inc(bitShift, 10);
  1396. end;
  1397. end;
  1398. last := #0;
  1399. end;
  1400. end;
  1401. if escaped then begin
  1402. raise EmUTF7Decode.create('Missing unescape in UTF7 sequence.'); {do not localize}
  1403. end else begin
  1404. if (bitBuf <> 0) then begin
  1405. raise EmUTF7Decode.create('Illegal bit boundaries in UTF7 sequence.'); {do not localize}
  1406. end;
  1407. end;
  1408. end;
  1409. function TIdMUTF7.Valid(aMUTF7String : string):boolean;
  1410. { -- mUTF7valid -------------------------------------------------------------
  1411. PRE: NIL
  1412. POST: returns true if string is correctly encoded (as described in mUTF7Encode)
  1413. returns false otherwise
  1414. }
  1415. begin
  1416. try
  1417. result := (aMUTF7String = {mUTF7}Encode({mUTF7}Decode(aMUTF7String)));
  1418. except
  1419. on e:EmUTF7Decode do begin result := false; end;
  1420. on e:EmUTF7Encode do begin result := false; end;
  1421. on e:exception do begin raise e; end; // do not handle others
  1422. end;
  1423. end;
  1424. function TIdMUTF7.Append(const aMUTF7String, aAnsiStr : string):string;
  1425. { -- mUTF7Append -------------------------------------------------------------
  1426. PRE: aMUTF7String is complying to mUTF7Encode's description
  1427. POST: SUCCESS: a concatenation of both input strings in mUTF
  1428. FAILURE: an exception of EMUTF7Decode or EMUTF7Decode will be raised
  1429. }
  1430. begin
  1431. result := {mUTF7}Encode({mUTF7}Decode(aMUTF7String) + aAnsiStr);
  1432. end;
  1433. { TIdImapMessageParts }
  1434. constructor TIdImapMessagePart.Create(Collection: TCollection);
  1435. begin
  1436. {Make sure these are initialised properly...}
  1437. inherited Create(Collection);
  1438. FParentPart := -1;
  1439. FBoundary := ''; {Do not Localize}
  1440. end;
  1441. function TIdImapMessageParts.GetItem(Index: Integer): TIdImapMessagePart;
  1442. begin
  1443. Result := TIdImapMessagePart(inherited GetItem(Index));
  1444. end;
  1445. function TIdImapMessageParts.Add: TIdImapMessagePart;
  1446. begin
  1447. Result := TIdImapMessagePart(inherited Add);
  1448. end;
  1449. procedure TIdImapMessageParts.SetItem(Index: Integer; const Value: TIdImapMessagePart);
  1450. begin
  1451. inherited SetItem(Index, Value);
  1452. end;
  1453. { TIdIMAP4 }
  1454. //The following call FMUTF7 but do exception-handling on invalid strings...
  1455. function TIdIMAP4.DoMUTFEncode(aString : string):string;
  1456. begin
  1457. try
  1458. Result := FMUTF7.Encode(aString);
  1459. except
  1460. Result := aString;
  1461. end;
  1462. end;
  1463. function TIdIMAP4.DoMUTFDecode(aString : string):string;
  1464. begin
  1465. try
  1466. Result := FMUTF7.Decode(aString);
  1467. except
  1468. Result := aString;
  1469. end;
  1470. end;
  1471. function TIdIMAP4.GetReplyClass:TIdReplyClass;
  1472. begin
  1473. result:=TIdReplyIMAP4;
  1474. end;
  1475. function TIdIMAP4.FindHowServerCreatesFolders: TIdIMAP4FolderTreatment;
  1476. label
  1477. GotInbox, TryAgain, TryAgainSub;
  1478. var
  1479. LUsersFolders: TIdStringList;
  1480. LN: integer;
  1481. LInbox: string;
  1482. LTestFolder: string;
  1483. begin
  1484. LUsersFolders := TIdStringList.Create;
  1485. //Get folder names...
  1486. if ((ListMailBoxes(LUsersFolders) = False) or (LUsersFolders.Count = 0)) then begin
  1487. Result := ftCannotRetrieveAnyFolders;
  1488. Exit;
  1489. end;
  1490. //Do we have an Inbox?
  1491. for LN := 0 to LUsersFolders.Count-1 do begin
  1492. if UpperCase(LUsersFolders.Strings[LN]) = 'INBOX' then begin {Do not Localize}
  1493. LInbox := LUsersFolders.Strings[LN];
  1494. goto GotInbox;
  1495. end;
  1496. end;
  1497. Result := ftCannotTestBecauseHasNoInbox;
  1498. Exit;
  1499. GotInbox:
  1500. //Make sure our test folder does not already exist at the top level...
  1501. LTestFolder := 'CiaransTestFolder'; {Do not Localize}
  1502. TryAgain:
  1503. for LN := 0 to LUsersFolders.Count-1 do begin
  1504. if UpperCase(LUsersFolders.Strings[LN]) = UpperCase(LTestFolder) then begin
  1505. LTestFolder := LTestFolder + '9'; {Do not Localize}
  1506. goto TryAgain;
  1507. end;
  1508. end;
  1509. //Try to create LTestFolder at the top level...
  1510. if CreateMailbox(LTestFolder) = True then begin
  1511. //We were able to create it at the top level - delete it and exit..
  1512. DeleteMailbox(LTestFolder);
  1513. Result := ftAllowsTopLevelCreation;
  1514. Exit;
  1515. end;
  1516. //See if our test folder does not exist under INBOX...
  1517. LTestFolder := 'CiaransTestFolder'; {Do not Localize}
  1518. TryAgainSub:
  1519. for LN := 0 to LUsersFolders.Count-1 do begin
  1520. if UpperCase(LUsersFolders.Strings[LN]) = UpperCase(LInbox+FMailBoxSeparator+LTestFolder) then begin
  1521. LTestFolder := LTestFolder + '9'; {Do not Localize}
  1522. goto TryAgain;
  1523. end;
  1524. end;
  1525. //Try to create LTestFolder under Inbox...
  1526. if CreateMailbox(LInbox+FMailBoxSeparator+LTestFolder) = True then begin
  1527. //We were able to create it at the top level - delete it and exit..
  1528. DeleteMailbox(LInbox+FMailBoxSeparator+LTestFolder);
  1529. Result := ftFoldersMustBeUnderInbox;
  1530. Exit;
  1531. end;
  1532. //It does not allow us create folders under any level (read-only?)...
  1533. Result := ftDoesNotAllowFolderCreation;
  1534. end;
  1535. function TIdIMAP4.IsNumberValid(const ANumber: Integer): Boolean;
  1536. {CC3: Need to validate message numbers (relative and UIDs), because otherwise
  1537. the routines wait for a response that never arrives and so functions never return.}
  1538. begin
  1539. if ANumber < 1 then begin
  1540. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1541. end;
  1542. Result := True;
  1543. end;
  1544. function TIdIMAP4.IsUIDValid(const AUID: string): Boolean;
  1545. {CC3: Need to validate message numbers (relative and UIDs), because otherwise
  1546. the routines wait for a response that never arrives and so functions never return.}
  1547. begin
  1548. //Must be digits only (no - or .)
  1549. IsItDigitsAndOptionallyPeriod(AUID, False);
  1550. Result := IsNumberValid(StrToInt(AUID));
  1551. end;
  1552. function TIdIMAP4.IsImapPartNumberValid(const AUID: string): Boolean;
  1553. {CC3: IMAP part numbers are 3 or 4.5 etc, i.e. digits or period allowed}
  1554. begin
  1555. Result := IsItDigitsAndOptionallyPeriod(AUID, True);
  1556. end;
  1557. function TIdIMAP4.IsItDigitsAndOptionallyPeriod(const AStr: string; AAllowPeriod: Boolean): Boolean;
  1558. var
  1559. LN: integer;
  1560. begin
  1561. if AStr = '' then begin {Do not Localize}
  1562. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1563. end;
  1564. for LN := 1 to length(AStr) do begin
  1565. if ( (Ord(AStr[LN]) < Ord('0')) or (Ord(AStr[LN]) > Ord('9')) ) then begin {Do not Localize}
  1566. if AAllowPeriod = True then begin
  1567. if AStr[LN] <> '.' then begin {Do not Localize}
  1568. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1569. end;
  1570. end else begin
  1571. raise EIdNumberInvalid.Create(RSIMAP4NumberInvalid);
  1572. end;
  1573. end;
  1574. end;
  1575. Result := True;
  1576. end;
  1577. function TIdIMAP4.GetUID(const AMsgNum: Integer; var AUID: string): Boolean;
  1578. {This gets the message UID from the message relative number.}
  1579. begin
  1580. Result := False;
  1581. AUID := ''; {Do not Localize}
  1582. IsNumberValid(AMsgNum);
  1583. if (FConnectionState = csSelected) then begin
  1584. {Some servers return NO if the requested message number is not present
  1585. (e.g. Cyrus), others return OK but no data (CommuniGate).}
  1586. SendCmd(NewCmdCounter, (IMAP4Commands[cmdFetch] + ' ' + IntToStr(AMsgNum) + {Do not Localize}
  1587. ' (' + IMAP4FetchDataItem[fdUID] + ')' ), [IMAP4Commands[cmdFetch]]); {Do not Localize}
  1588. if (LastCmdResult.Code = IMAP_OK) then begin
  1589. //Might as well leave 3rd param as [] because ParseLastCmdResult always grabs the UID...
  1590. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], []) = True then begin
  1591. AUID := FLineStruct.UID;
  1592. Result := True;
  1593. end;
  1594. end;
  1595. end else begin
  1596. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
  1597. end;
  1598. end;
  1599. procedure TIdIMAP4.WriteLn(AOut: string);
  1600. begin
  1601. IOHandler.WriteLn(AOut);
  1602. end;
  1603. function TIdIMAP4.ReadLnWait: string;
  1604. var LLine: string;
  1605. begin
  1606. LLine := inherited IOHandler.ReadLnWait; {This can have hit an exception of Connection Reset By Peer (timeout)}
  1607. Result := LLine;
  1608. end;
  1609. { IdTCPConnection Commands... }
  1610. function TIdIMAP4.GetInternalResponse (const ATag: String; AExpectedResponses: array of String;
  1611. ASingleLineMode: Boolean; ASingleLineMayBeSplit: Boolean {= False}): string;
  1612. {ASingleLineMode is True if the caller just wants the FIRST line of the response,
  1613. e.g., he may be looking only for "* FETCH (blah blah)", because he needs to parse
  1614. that line to figure out how the rest will follow. This arises with a number of the
  1615. FETCH commands where the caller needs to get the byte-count from the first line
  1616. before he can retrieve the rest of the response.
  1617. Note "FETCH" would have to be in AExpectedResponses.
  1618. When False, the caller wants everything up to and including the reply terminator
  1619. (e.g. "C45 OK Completed").
  1620. In ASingleLineMode, we ignore any lines that dont have one of AExpectedResponses
  1621. at the start, otherwise we add all lines to .Text and later strip out any lines that
  1622. dont have one of AExpectedResponses at the start.
  1623. ASingleLineMayBeSplit (which should only be used with ASingleLineMode = True) deals
  1624. with the (unusual) case where the server cannot or does not fit a single-line
  1625. response onto one line. This arises when FETCHing the BODYSTRUCTURE, which can
  1626. be very long. The server (Courier, anyway) signals it by adding a byte-count to
  1627. the end of the first line, that would not normally be present.}
  1628. //For example, for normal short responses, the server would send:
  1629. // * FETCH (BODYSTRUCTURE (Part1 Part2))
  1630. //but if it splits it, it sends:
  1631. // * FETCH (BODYSTRUCTURE (Part1 {16}
  1632. // Part2))
  1633. //The number in the chain brackets {16} seems to be random.
  1634. {WARNING: If you use ASingleLineMayBeSplit on a line that is EXPECTED to end
  1635. with a byte-count, the code will break, so don't use it unless absolutely
  1636. necessary.}
  1637. var LLine: String;
  1638. LResponse: TIdStringList;
  1639. LWord: string;
  1640. LPos: integer;
  1641. LGotALineWithAnExpectedResponse: Boolean;
  1642. LStrippedLine: string;
  1643. LSplitLine: string;
  1644. begin
  1645. LResponse := TIdStringList.Create;
  1646. LGotALineWithAnExpectedResponse := False;
  1647. try
  1648. repeat
  1649. LLine := ReadLnWait;
  1650. LResponse.Add(LLine);
  1651. {CCB: Trap case of server telling you that you have been disconnected, usually because
  1652. you were inactive for too long (get "* BYE idle time too long"). }
  1653. if (TextIsSame(Copy (LLine, 1, 5), '* BYE')) then begin {Do not Localize}
  1654. {If BYE is in AExpectedResponses, this means we are expecting to
  1655. disconnect, i.e. it is a LOGOUT.}
  1656. if PosInStrArray('BYE', AExpectedResponses) = -1 then begin {Do not Localize}
  1657. {We were not expecting a BYE response.
  1658. For the moment, throw an exception. Could modify this by adding a
  1659. ReconnectOnDisconnect property to automatically reconnect?}
  1660. FConnectionState := csUnexpectedlyDisconnected;
  1661. raise EIdDisconnectedProbablyIdledOut.Create(RSIMAP4DisconnectedProbablyIdledOut);
  1662. end;
  1663. end;
  1664. if ASingleLineMode then begin
  1665. LStrippedLine := LLine;
  1666. if Length(LStrippedLine) > 1 then begin
  1667. if ((LStrippedLine[1] = '*') and (LStrippedLine[2] = ' ')) then begin {Do not Localize}
  1668. LStrippedLine := Copy(LStrippedLine, 3, MAXINT);
  1669. end;
  1670. end;
  1671. LGotALineWithAnExpectedResponse := TIdReplyIMAP4(FLastCmdResult).DoesLineHaveExpectedResponse(LStrippedLine, AExpectedResponses);
  1672. if LGotALineWithAnExpectedResponse then begin
  1673. //See if it may continue on the next line...
  1674. if ASingleLineMayBeSplit = True then begin
  1675. //If the line is split, it will have a byte-count field at the end...
  1676. while LStrippedLine[Length(LStrippedLine)] = '}' do begin
  1677. //It is split.
  1678. //First, remove the byte count...
  1679. LPos := Length(LStrippedLine)-1;
  1680. while LStrippedLine[LPos] <> '{' do begin
  1681. Dec(LPos);
  1682. end;
  1683. LStrippedLine := Copy(LStrippedLine, 1, LPos-1);
  1684. //The rest of the reply is on the following line...
  1685. LSplitLine := ReadLnWait; //Cannot thrash LLine, need it later
  1686. LResponse.Add(LSplitLine);
  1687. LStrippedLine := LStrippedLine + LSplitLine;
  1688. end;
  1689. end;
  1690. FLastCmdResult.Text.Clear;
  1691. TIdReplyIMAP4(FLastCmdResult).Extra.Clear;
  1692. FLastCmdResult.Text.Add(LStrippedLine);
  1693. end;
  1694. end;
  1695. //Need to get the 1st word on the line in case it is +, PREAUTH, etc...
  1696. LPos := Pos(' ', LLine); {Do not Localize}
  1697. if LPos <> 0 then begin
  1698. {There are at least two words on this line...}
  1699. LWord := Trim(Copy(LLine, 1, LPos-1));
  1700. end;
  1701. until (
  1702. (TextIsSame(Copy (LLine, 1, Length (ATag)), ATag))
  1703. or (PosInStrArray(LWord, VALID_TAGGEDREPLIES) > -1)
  1704. or (LGotALineWithAnExpectedResponse = True)
  1705. );
  1706. if LGotALineWithAnExpectedResponse = True then begin
  1707. //This only arises if ASingleLineMode is True...
  1708. FLastCmdResult.Code := IMAP_OK;
  1709. end else begin
  1710. FLastCmdResult.FormattedReply := LResponse;
  1711. TIdReplyIMAP4(FLastCmdResult).RemoveUnsolicitedResponses(AExpectedResponses);
  1712. end;
  1713. Result := FLastCmdResult.Code;
  1714. finally
  1715. FreeAndNil (LResponse);
  1716. end;
  1717. end;
  1718. function TIdIMAP4.SendCmd(const AOut: string; AExpectedResponses: array of String): string;
  1719. begin
  1720. Result := SendCmd(NewCmdCounter,AOut,AExpectedResponses);
  1721. end;
  1722. function TIdIMAP4.SendCmd(const ATag, AOut: string; AExpectedResponses: array of String): string;
  1723. var
  1724. LDataInBuffer: Boolean;
  1725. begin
  1726. if ( AOut <> #0 ) then begin
  1727. repeat
  1728. //Remove anything that may be unprocessed from a previous (probably failed) command...
  1729. LDataInBuffer := inherited IOHandler.Readable(MilliSecsToWaitToClearBuffer);
  1730. if LDataInBuffer then begin
  1731. inherited IOHandler.ReadLnWait;
  1732. end;
  1733. until LDataInBuffer = False;
  1734. {CC3: Catch "Connection reset by peer"...}
  1735. try
  1736. WriteLn ( ATag + ' ' + AOut ); {Do not Localize}
  1737. except
  1738. //on E: Exception do begin
  1739. on E: EIdSocketError do begin
  1740. if e.LastError = 10054 then begin
  1741. //Connection reset by peer...
  1742. FConnectionState := csUnexpectedlyDisconnected;
  1743. raise;
  1744. end;
  1745. end;
  1746. end;
  1747. end;
  1748. Result := GetInternalResponse ( ATag , AExpectedResponses, False );
  1749. end;
  1750. { ...IdTCPConnection Commands }
  1751. procedure TIdIMAP4.DoAlert(const AMsg: String);
  1752. begin
  1753. if Assigned(OnAlert) then begin
  1754. OnAlert(Self, AMsg);
  1755. end;
  1756. end;
  1757. procedure TIdIMAP4.SetMailBox(const Value: TIdMailBox);
  1758. begin
  1759. FMailBox.Assign(Value);
  1760. end;
  1761. procedure TIdIMAP4.Login;
  1762. begin
  1763. try
  1764. if UseTLS in ExplicitTLSVals then begin
  1765. if SupportsTLS then begin
  1766. if SendCmd(NewCmdCounter, 'STARTTLS', []) = IMAP_OK then begin {Do not Localize}
  1767. TLSHandshake;
  1768. //obtain capabilities again - RFC2595
  1769. {CC7: Capability (with no TIdStrings param) changed when LoginSASL moved to TIdSASLList...}
  1770. Capability(FCapabilities);
  1771. end else begin
  1772. ProcessTLSNegCmdFailed;
  1773. end;
  1774. end else begin
  1775. ProcessTLSNotAvail;
  1776. end;
  1777. end;
  1778. {CC7: FGreetingCode removed when LoginSASL moved from TIdMessageSASLClient to TIdSASLList...}
  1779. if ( LastCmdResult.Code = IMAP_OK ) then begin
  1780. FConnectionState := csNonAuthenticated;
  1781. FCmdCounter := 0;
  1782. {CC7: Self.AuthenticationType changed to FAuthType when LoginSASL moved
  1783. from TIdMessageSASLClient to TIdSASLList...}
  1784. if FAuthType = atUserPass then begin
  1785. if Password <> '' then begin {Do not Localize}
  1786. SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username + ' ' + Password, []); {Do not Localize}
  1787. end else begin
  1788. SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogin] + ' ' + Username, []); {Do not Localize}
  1789. end;
  1790. if ( LastCmdResult.Code = IMAP_OK ) then begin
  1791. FConnectionState := csAuthenticated;
  1792. {CC7: Capability (with no TIdStrings param) changed when LoginSASL moved to TIdSASLList...}
  1793. Capability(FCapabilities);
  1794. end;
  1795. end else begin
  1796. //CC7: Changed again due to more changes in Indy 10...
  1797. if Capability(FCapabilities) = True then begin
  1798. FSASLMechanisms.LoginSASL('AUTHENTICATE', ['* OK'], ['* +'], Self, FCapabilities); {Do not Localize}
  1799. end;
  1800. {CC7: Capability (with no TIdStrings param) changed when LoginSASL moved to TIdSASLList...}
  1801. Capability(FCapabilities);
  1802. end;
  1803. end else begin
  1804. if ( LastCmdResult.Code = IMAP_PREAUTH ) then begin
  1805. FConnectionState := csAuthenticated;
  1806. FCmdCounter := 0;
  1807. end;
  1808. end;
  1809. {CC7: Capability (with no TIdStrings param) changed when LoginSASL moved to TIdSASLList...}
  1810. Capability(FCapabilities);
  1811. except
  1812. Disconnect;
  1813. raise;
  1814. end;
  1815. end;
  1816. procedure TIdIMAP4.Connect(const AAndLogin: boolean = true);
  1817. begin
  1818. {CC2: Need to set FConnectionState to csNonAuthenticated here. If not, then
  1819. an unsuccessful connect after a previous successful connect (such as when a
  1820. client program changes users) can leave it as csAuthenticated.}
  1821. FConnectionState := csNonAuthenticated;
  1822. {CC2: Don't call Connect if already connected, this could be just a change of user}
  1823. if Connected = False then begin
  1824. try
  1825. inherited Connect;
  1826. except
  1827. Exit;
  1828. end;
  1829. end;
  1830. GetResponse;
  1831. if ((LastCmdResult.Code <> IMAP_OK) and (LastCmdResult.Code <> IMAP_PREAUTH)) then begin
  1832. {Should have got OK or PREAUTH in the greeting...}
  1833. end;
  1834. {CC7: Save FGreetingBanner so the user can use it to determine what type of
  1835. server he is connected to...}
  1836. if LastCmdResult.Text.Count > 0 then begin
  1837. FGreetingBanner := LastCmdResult.Text[0];
  1838. end else begin
  1839. FGreetingBanner := '';
  1840. end;
  1841. {CC7: Capability (with no TIdStrings param) removed when ParseCapaReply was
  1842. consolidated into LoginSASL in TIdSASLList...}
  1843. if AAndLogin then begin
  1844. Login;
  1845. end;
  1846. end;
  1847. procedure TIdIMAP4.InitComponent;
  1848. begin
  1849. inherited;
  1850. FMailBox := TIdMailBox.Create (Self);
  1851. Port := IdPORT_IMAP4;
  1852. FLineStruct := TIdIMAPLineStruct.Create;
  1853. FCapabilities := TIdStringList.Create;
  1854. FMUTF7 := TIdMUTF7.Create;
  1855. {$IFNDEF DOTNET}
  1856. //Todo: Not sure which number is appropriate. Should be tested
  1857. FImplicitTLSProtPort := IdPORT_IMAP4S; //Id_PORT_imap4_ssl_dp;
  1858. FRegularProtPort := IdPORT_IMAP4;
  1859. {$ENDIF}
  1860. FOnWorkForPart := nil;
  1861. FOnWorkBeginForPart := nil;
  1862. FOnWorkEndForPart := nil;
  1863. FMilliSecsToWaitToClearBuffer := IDF_DEFAULT_MS_TO_WAIT_TO_CLEAR_BUFFER;
  1864. FCmdCounter := 0;
  1865. FConnectionState := csNonAuthenticated;
  1866. FRetrieveOnSelect := rsDisabled;
  1867. {CC2: FMailBoxSeparator is now detected when a mailbox is selected, following
  1868. line is probably redundant, but leave it there just in case.}
  1869. FMailBoxSeparator := '/'; {Do not Localize}
  1870. end;
  1871. procedure TIdIMAP4.Disconnect(AImmediate: Boolean; const ARaiseExceptionIfNotCon : Boolean);
  1872. begin
  1873. //Available in any state.
  1874. if Connected then begin
  1875. //IMPORTANT: Logout must pass 'BYE' as the first
  1876. //element of the AExpectedResponses array (the 3rd param in SendCmd
  1877. //below), because this flags to GetInternalResponse that this is the
  1878. //logout, and it must EXPECT the BYE response
  1879. SendCmd ( NewCmdCounter, IMAP4Commands[cmdLogout], ['BYE'] ); {Do not Localize}
  1880. inherited Disconnect(AImmediate);
  1881. FConnectionState := csNonAuthenticated;
  1882. FCapabilities.Clear;
  1883. end else begin
  1884. if ARaiseExceptionIfNotCon then begin
  1885. raise EIdClosedSocket.Create ( RSStatusDisconnected );
  1886. end;
  1887. end;
  1888. end;
  1889. procedure TIdIMAP4.Disconnect;
  1890. begin
  1891. Disconnect(False, True);
  1892. end;
  1893. procedure TIdIMAP4.KeepAlive;
  1894. begin
  1895. //Avialable in any state.
  1896. SendCmd(NewCmdCounter, IMAP4Commands[cmdNoop], []);
  1897. end;
  1898. function TIdIMAP4.IsCapabilityListed(ACapability: string):Boolean;
  1899. var
  1900. LCapabilities: TIdStringList;
  1901. LN: Integer;
  1902. begin
  1903. Result := False;
  1904. LCapabilities := TIdStringList.Create;
  1905. if Capability(LCapabilities) = False then begin
  1906. LCapabilities.Free;
  1907. Exit;
  1908. end;
  1909. for LN := 0 to LCapabilities.Count-1 do begin
  1910. if UpperCase(ACapability) = UpperCase(LCapabilities.Strings[LN]) then begin
  1911. Result := True;
  1912. LCapabilities.Free;
  1913. Exit;
  1914. end;
  1915. end;
  1916. LCapabilities.Free;
  1917. end;
  1918. function TIdIMAP4.Capability(ASlCapability: TIdStrings): Boolean;
  1919. begin
  1920. //Available in any state.
  1921. ASlCapability.Clear;
  1922. Result := False;
  1923. SendCmd ( NewCmdCounter, (IMAP4Commands[CmdCapability]), [IMAP4Commands[CmdCapability]]);
  1924. if ( LastCmdResult.Code = IMAP_OK ) and Assigned (ASlCapability) then begin
  1925. ASlCapability.Clear;
  1926. if LastCmdResult.Text.Count > 0 then begin
  1927. BreakApart ( LastCmdResult.Text[0], ' ', ASlCapability ); {Do not Localize}
  1928. end;
  1929. ASlCapability.Delete(0);
  1930. Result := True;
  1931. end;
  1932. FHasCapa := Result;
  1933. end;
  1934. function TIdIMAP4.GetCmdCounter: String;
  1935. begin
  1936. Result := 'C' + IntToStr ( FCmdCounter ); {Do not Localize}
  1937. end;
  1938. function TIdIMAP4.GetNewCmdCounter: String;
  1939. begin
  1940. Inc ( FCmdCounter );
  1941. Result := 'C' + IntToStr ( FCmdCounter ); {Do not Localize}
  1942. end;
  1943. destructor TIdIMAP4.Destroy;
  1944. begin
  1945. {CC2: Disconnect before we die}
  1946. {CC7: Added "if Connected then" }
  1947. //Note we have to pass false to an overloaded method or
  1948. //an exception is raised in the destructor. That can cause weirdness in the IDE.
  1949. if Connected then begin
  1950. Disconnect(False, False);
  1951. end;
  1952. FreeAndNil(FMailBox);
  1953. FreeAndNil(FLineStruct);
  1954. inherited;
  1955. end;
  1956. function TIdIMAP4.SelectMailBox(const AMBName: String): Boolean;
  1957. begin
  1958. {CC2: Default to returning False at this point...}
  1959. Result := False;
  1960. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  1961. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdSelect] + ' "' + DoMUTFEncode(AMBName) + '"' ), {Do not Localize}
  1962. ['FLAGS', 'OK', 'EXISTS', 'RECENT', '[READ-WRITE]', '[ALERT]']); {Do not Localize}
  1963. if ( LastCmdResult.Code = IMAP_OK ) then begin
  1964. //Put the parse in the IMAP Class and send the MB;
  1965. ParseSelectResult (FMailBox, LastCmdResult.Text );
  1966. FMailBox.Name := AMBName;
  1967. FConnectionState := csSelected;
  1968. case RetrieveOnSelect of
  1969. rsHeaders: RetrieveAllHeaders ( FMailBox.MessageList );
  1970. rsMessages: RetrieveAllMsgs ( FMailBox.MessageList );
  1971. end;
  1972. {CC2: Only return TRUE if get to here...}
  1973. Result := True; {LastCmdResult.NumericCode = wsOk;}
  1974. end else begin
  1975. FConnectionState := csAuthenticated;
  1976. end;
  1977. end else begin
  1978. FConnectionState := csAuthenticated;
  1979. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
  1980. end;
  1981. end;
  1982. function TIdIMAP4.ExamineMailBox(const AMBName: String; AMB: TIdMailBox): Boolean;
  1983. begin
  1984. {CC2: Default to returning False at this point...}
  1985. Result := False;
  1986. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  1987. //TO DO: Check that Examine's expected responses really are STATUS, FLAGS and OK...
  1988. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdExamine] + ' "' + DoMUTFEncode(AMBName) + '"' ), {Do not Localize}
  1989. ['STATUS', 'FLAGS', 'OK', 'EXISTS', 'RECENT', '[READ-WRITE]', '[ALERT]']); {Do not Localize}
  1990. if ( LastCmdResult.Code = IMAP_OK ) then begin
  1991. ParseSelectResult (AMB, LastCmdResult.Text );
  1992. AMB.Name := AMBName;
  1993. {CC2: Only return TRUE if get to here...}
  1994. Result := True;
  1995. end;
  1996. end else begin
  1997. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  1998. end;
  1999. end;
  2000. function TIdIMAP4.CloseMailBox: Boolean;
  2001. begin
  2002. {CC2: Default to returning False at this point...}
  2003. Result := False;
  2004. if ( FConnectionState = csSelected ) then begin
  2005. SendCmd ( NewCmdCounter, IMAP4Commands[cmdClose], [] );
  2006. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2007. MailBox.Clear;
  2008. FConnectionState := csAuthenticated;
  2009. {CC2: Only return TRUE if get to here...}
  2010. Result := True;
  2011. end;
  2012. end else begin
  2013. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2014. end;
  2015. end;
  2016. function TIdIMAP4.CreateMailBox(const AMBName: String): Boolean;
  2017. begin
  2018. {CC5: Recode to return False if NO returned rather than throwing an exception...}
  2019. Result := False;
  2020. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2021. {CC5: The NO response is typically due to Permission Denied}
  2022. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdCreate] + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2023. if LastCmdResult.Code = IMAP_OK then begin
  2024. Result := True;
  2025. end;
  2026. end else begin
  2027. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2028. end;
  2029. end;
  2030. function TIdIMAP4.DeleteMailBox(const AMBName: String): Boolean;
  2031. begin
  2032. {CC5: Recode to return False if NO returned rather than throwing an exception...}
  2033. Result := False;
  2034. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2035. {CC5: The NO response is typically due to Permission Denied}
  2036. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdDelete] + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2037. if LastCmdResult.Code = IMAP_OK then begin
  2038. Result := True;
  2039. end;
  2040. end else begin
  2041. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2042. end;
  2043. end;
  2044. function TIdIMAP4.RenameMailBox(const AOldMBName, ANewMBName: String): Boolean;
  2045. begin
  2046. {CC5: Recode to return False if NO returned rather than throwing an exception...}
  2047. Result := False;
  2048. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2049. {CC5: The NO response is typically due to Permission Denied}
  2050. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdRename] + ' "' + {Do not Localize}
  2051. DoMUTFEncode(AOldMBName) + '" "' + DoMUTFEncode(ANewMBName) + '"' ), [] ); {Do not Localize}
  2052. if LastCmdResult.Code = IMAP_OK then begin
  2053. Result := True;
  2054. end;
  2055. end else begin
  2056. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2057. end;
  2058. end;
  2059. function TIdIMAP4.StatusMailBox(const AMBName: String; AMB: TIdMailBox): Boolean;
  2060. {CC2: It is pointless calling StatusMailBox with AStatusDataItems set to []
  2061. because you are asking the IMAP server to update none of the status flags.
  2062. Instead, if called with no AStatusDataItems specified, use the standard flags
  2063. returned by SelectMailBox, which allows the user to easily check if the mailbox
  2064. has changed. Overload the functions, since AStatusDataItems cannot be set
  2065. to nil.}
  2066. var
  2067. AStatusDataItems: array[1..5] of TIdIMAP4StatusDataItem;
  2068. begin
  2069. AStatusDataItems[1] := mdMessages;
  2070. AStatusDataItems[2] := mdRecent;
  2071. AStatusDataItems[3] := mdUIDNext;
  2072. AStatusDataItems[4] := mdUIDValidity;
  2073. AStatusDataItems[5] := mdUnseen;
  2074. Result := StatusMailBox(AMBName, AMB, AStatusDataItems);
  2075. end;
  2076. function TIdIMAP4.StatusMailBox(const AMBName: String; AMB: TIdMailBox; const AStatusDataItems: array of TIdIMAP4StatusDataItem): Boolean;
  2077. var LDataItems : String;
  2078. Ln : Integer;
  2079. begin
  2080. {CC2: Default to returning False at this point...}
  2081. Result := False;
  2082. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2083. for Ln := Low ( AStatusDataItems ) to High ( AStatusDataItems ) do begin
  2084. case AStatusDataItems[Ln] of
  2085. mdMessages: LDataItems := LDataItems + IMAP4StatusDataItem[mdMessages] + ' '; {Do not Localize}
  2086. mdRecent: LDataItems := LDataItems + IMAP4StatusDataItem[mdRecent] + ' '; {Do not Localize}
  2087. mdUIDNext: LDataItems := LDataItems + IMAP4StatusDataItem[mdUIDNext] + ' '; {Do not Localize}
  2088. mdUIDValidity: LDataItems := LDataItems + IMAP4StatusDataItem[mdUIDValidity] + ' '; {Do not Localize}
  2089. mdUnseen: LDataItems := LDataItems + IMAP4StatusDataItem[mdUnseen] + ' '; {Do not Localize}
  2090. end;
  2091. end;
  2092. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdStatus] + ' "' + DoMUTFEncode(AMBName) + '" (' + {Do not Localize}
  2093. Trim ( LDataItems ) + ')' ), [IMAP4Commands[cmdStatus]] ); {Do not Localize} {Do not Localize}
  2094. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2095. ParseStatusResult ( AMB, LastCmdResult.Text );
  2096. {CC2: Only return TRUE if get to here...}
  2097. Result := True;
  2098. end;
  2099. end else begin
  2100. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2101. end;
  2102. end;
  2103. function TIdIMAP4.CheckMailBox: Boolean;
  2104. begin
  2105. Result := False;
  2106. if ( FConnectionState = csSelected ) then begin
  2107. SendCmd ( NewCmdCounter, IMAP4Commands[cmdCheck], [] );
  2108. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2109. Result := True; {LastCmdResult.NumericCode = wsOk;}
  2110. end;
  2111. end else begin
  2112. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2113. end;
  2114. end;
  2115. function TIdIMAP4.ExpungeMailBox: Boolean;
  2116. begin
  2117. Result := False;
  2118. if ( FConnectionState = csSelected ) then begin
  2119. SendCmd ( NewCmdCounter, IMAP4Commands[cmdExpunge], [] );
  2120. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2121. ParseExpungeResult ( FMailBox, LastCmdResult.Text );
  2122. Result := True; {LastCmdResult.NumericCode = wsOk;}
  2123. end;
  2124. end else begin
  2125. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2126. end;
  2127. end;
  2128. function TIdIMAP4.SearchMailBox(
  2129. const ASearchInfo: array of TIdIMAP4SearchRec{Array} ) : Boolean;
  2130. var LSearchStr : String;
  2131. Ln : Integer;
  2132. begin
  2133. {CC2: Default to returning False at this point...}
  2134. Result := False;
  2135. for Ln := Low ( ASearchInfo ) to High ( ASearchInfo ) do
  2136. case ASearchInfo[Ln].SearchKey of
  2137. skAnswered:
  2138. LSearchStr := LSearchStr + IMAP4SearchKeys[skAnswered] + ' '; {Do not Localize}
  2139. skBcc:
  2140. LSearchStr := LSearchStr + IMAP4SearchKeys[skBcc] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2141. skBefore:
  2142. LSearchStr := LSearchStr + IMAP4SearchKeys[skBefore] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2143. skBody:
  2144. LSearchStr := LSearchStr + IMAP4SearchKeys[skBody] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2145. skCc:
  2146. LSearchStr := LSearchStr + IMAP4SearchKeys[skCc] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2147. skDeleted:
  2148. LSearchStr := LSearchStr + IMAP4SearchKeys[skDeleted] + ' '; {Do not Localize}
  2149. skDraft:
  2150. LSearchStr := LSearchStr + IMAP4SearchKeys[skDraft] + ' '; {Do not Localize}
  2151. skFlagged:
  2152. LSearchStr := LSearchStr + IMAP4SearchKeys[skFlagged] + ' '; {Do not Localize}
  2153. skFrom:
  2154. LSearchStr := LSearchStr + IMAP4SearchKeys[skFrom] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2155. skLarger:
  2156. LSearchStr := LSearchStr + IMAP4SearchKeys[skLarger] + ' ' + IntToStr ( ASearchInfo[Ln].Size ) + ' '; {Do not Localize}
  2157. skNew:
  2158. LSearchStr := LSearchStr + IMAP4SearchKeys[skNew] + ' '; {Do not Localize}
  2159. skNot:
  2160. LSearchStr := LSearchStr + IMAP4SearchKeys[skNot] + ' '; {Do not Localize}
  2161. skOld:
  2162. LSearchStr := LSearchStr + IMAP4SearchKeys[skOld] + ' '; {Do not Localize}
  2163. skOn:
  2164. LSearchStr := LSearchStr + IMAP4SearchKeys[skOn] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2165. skOr:
  2166. LSearchStr := LSearchStr + IMAP4SearchKeys[skOr] + ' '; {Do not Localize}
  2167. skRecent:
  2168. LSearchStr := LSearchStr + IMAP4SearchKeys[skRecent] + ' '; {Do not Localize}
  2169. skSeen:
  2170. LSearchStr := LSearchStr + IMAP4SearchKeys[skSeen] + ' '; {Do not Localize}
  2171. skSentBefore:
  2172. LSearchStr := LSearchStr + IMAP4SearchKeys[skSentBefore] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2173. skSentOn:
  2174. LSearchStr := LSearchStr + IMAP4SearchKeys[skSentOn] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2175. skSentSince:
  2176. LSearchStr := LSearchStr + IMAP4SearchKeys[skSentSince] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2177. skSince:
  2178. LSearchStr := LSearchStr + IMAP4SearchKeys[skSince] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2179. skSmaller:
  2180. LSearchStr := LSearchStr + IMAP4SearchKeys[skSmaller] + ' ' + IntToStr ( ASearchInfo[Ln].Size ) + ' '; {Do not Localize}
  2181. skSubject:
  2182. LSearchStr := LSearchStr + IMAP4SearchKeys[skSubject] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2183. skText:
  2184. LSearchStr := LSearchStr + IMAP4SearchKeys[skText] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2185. skTo:
  2186. LSearchStr := LSearchStr + IMAP4SearchKeys[skTo] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2187. skUID:
  2188. LSearchStr := LSearchStr + IMAP4SearchKeys[skUID] + ' ' + ASearchInfo[Ln].Text + ' '; {Do not Localize}
  2189. skUnanswered:
  2190. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnanswered] + ' '; {Do not Localize}
  2191. skUndeleted:
  2192. LSearchStr := LSearchStr + IMAP4SearchKeys[skUndeleted] + ' '; {Do not Localize}
  2193. skUndraft:
  2194. LSearchStr := LSearchStr + IMAP4SearchKeys[skUndraft] + ' '; {Do not Localize}
  2195. skUnflagged:
  2196. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnflagged] + ' '; {Do not Localize}
  2197. skUnKeyWord:
  2198. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnKeyWord] + ' '; {Do not Localize}
  2199. skUnseen:
  2200. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnseen] + ' '; {Do not Localize}
  2201. end;
  2202. if ( FConnectionState = csSelected ) then begin
  2203. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdSearch] + ' ' + Trim (LSearchStr) ), [IMAP4Commands[cmdSearch]] ); {Do not Localize}
  2204. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2205. ParseSearchResult (FMailBox, LastCmdResult.Text);
  2206. {CC2: Only return TRUE if get to here...}
  2207. Result := True;
  2208. end;
  2209. end else begin
  2210. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2211. end;
  2212. end;
  2213. function TIdIMAP4.UIDSearchMailBox(const ASearchInfo: array of TIdIMAP4SearchRec) : Boolean;
  2214. var LSearchStr : String;
  2215. Ln : Integer;
  2216. begin
  2217. {CC2: Default to returning False at this point...}
  2218. Result := False;
  2219. for Ln := Low ( ASearchInfo ) to High ( ASearchInfo ) do
  2220. case ASearchInfo[Ln].SearchKey of
  2221. skAnswered:
  2222. LSearchStr := LSearchStr + IMAP4SearchKeys[skAnswered] + ' '; {Do not Localize}
  2223. skBcc:
  2224. LSearchStr := LSearchStr + IMAP4SearchKeys[skBcc] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2225. skBefore:
  2226. LSearchStr := LSearchStr + IMAP4SearchKeys[skBefore] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2227. skBody:
  2228. LSearchStr := LSearchStr + IMAP4SearchKeys[skBody] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2229. skCc:
  2230. LSearchStr := LSearchStr + IMAP4SearchKeys[skCc] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2231. skDeleted:
  2232. LSearchStr := LSearchStr + IMAP4SearchKeys[skDeleted] + ' '; {Do not Localize}
  2233. skDraft:
  2234. LSearchStr := LSearchStr + IMAP4SearchKeys[skDraft] + ' '; {Do not Localize}
  2235. skFlagged:
  2236. LSearchStr := LSearchStr + IMAP4SearchKeys[skFlagged] + ' '; {Do not Localize}
  2237. skFrom:
  2238. LSearchStr := LSearchStr + IMAP4SearchKeys[skFrom] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2239. //skHeader: //Need to check
  2240. //skKeyword: //Need to check
  2241. skLarger:
  2242. LSearchStr := LSearchStr + IMAP4SearchKeys[skLarger] + ' ' + IntToStr ( ASearchInfo[Ln].Size ) + ' '; {Do not Localize}
  2243. skNew:
  2244. LSearchStr := LSearchStr + IMAP4SearchKeys[skNew] + ' '; {Do not Localize}
  2245. skNot:
  2246. LSearchStr := LSearchStr + IMAP4SearchKeys[skNot] + ' '; {Do not Localize}
  2247. skOld:
  2248. LSearchStr := LSearchStr + IMAP4SearchKeys[skOld] + ' '; {Do not Localize}
  2249. skOn:
  2250. LSearchStr := LSearchStr + IMAP4SearchKeys[skOn] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2251. skOr:
  2252. LSearchStr := LSearchStr + IMAP4SearchKeys[skOr] + ' '; {Do not Localize}
  2253. skRecent:
  2254. LSearchStr := LSearchStr + IMAP4SearchKeys[skRecent] + ' '; {Do not Localize}
  2255. skSeen:
  2256. LSearchStr := LSearchStr + IMAP4SearchKeys[skSeen] + ' '; {Do not Localize}
  2257. skSentBefore:
  2258. LSearchStr := LSearchStr + IMAP4SearchKeys[skSentBefore] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2259. skSentOn:
  2260. LSearchStr := LSearchStr + IMAP4SearchKeys[skSentOn] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2261. skSentSince:
  2262. LSearchStr := LSearchStr + IMAP4SearchKeys[skSentSince] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2263. skSince:
  2264. LSearchStr := LSearchStr + IMAP4SearchKeys[skSince] + ' ' + DateToIMAPDateStr ( ASearchInfo[Ln].Date ) + ' '; {Do not Localize}
  2265. skSmaller:
  2266. LSearchStr := LSearchStr + IMAP4SearchKeys[skSmaller] + ' ' + IntToStr ( ASearchInfo[Ln].Size ) + ' '; {Do not Localize}
  2267. skSubject:
  2268. LSearchStr := LSearchStr + IMAP4SearchKeys[skSubject] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2269. skText:
  2270. LSearchStr := LSearchStr + IMAP4SearchKeys[skText] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2271. skTo:
  2272. LSearchStr := LSearchStr + IMAP4SearchKeys[skTo] + ' "' + ASearchInfo[Ln].Text + '" '; {Do not Localize}
  2273. skUID:
  2274. LSearchStr := LSearchStr + IMAP4SearchKeys[skUID] + ' ' + ASearchInfo[Ln].Text + ' '; {Do not Localize}
  2275. skUnanswered:
  2276. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnanswered] + ' '; {Do not Localize}
  2277. skUndeleted:
  2278. LSearchStr := LSearchStr + IMAP4SearchKeys[skUndeleted] + ' '; {Do not Localize}
  2279. skUndraft:
  2280. LSearchStr := LSearchStr + IMAP4SearchKeys[skUndraft] + ' '; {Do not Localize}
  2281. skUnflagged:
  2282. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnflagged] + ' '; {Do not Localize}
  2283. skUnKeyWord:
  2284. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnKeyWord] + ' '; {Do not Localize}
  2285. skUnseen:
  2286. LSearchStr := LSearchStr + IMAP4SearchKeys[skUnseen] + ' '; {Do not Localize}
  2287. end;
  2288. if ( FConnectionState = csSelected ) then begin
  2289. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdSearch] + ' ' + Trim (LSearchStr) ), {Do not Localize}
  2290. [IMAP4Commands[cmdSearch], IMAP4Commands[cmdUID]] ); {Do not Localize}
  2291. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2292. ParseSearchResult (FMailBox, LastCmdResult.Text);
  2293. {CC2: Only return TRUE if get to here...}
  2294. Result := True;
  2295. end;
  2296. end else begin
  2297. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2298. end;
  2299. end;
  2300. function TIdIMAP4.SubscribeMailBox(const AMBName: String): Boolean;
  2301. begin
  2302. Result := False;
  2303. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2304. SendCmd ( NewCmdCounter, (
  2305. IMAP4Commands[cmdSubscribe] + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2306. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2307. Result := True;
  2308. end;
  2309. end else begin
  2310. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2311. end;
  2312. end;
  2313. function TIdIMAP4.UnsubscribeMailBox(const AMBName: String): Boolean;
  2314. begin
  2315. Result := False;
  2316. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2317. SendCmd ( NewCmdCounter, (
  2318. IMAP4Commands[cmdUnsubscribe] + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2319. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2320. Result := True;
  2321. end;
  2322. end else begin
  2323. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2324. end;
  2325. end;
  2326. function TIdIMAP4.ListMailBoxes(AMailBoxList: TIdStringList): Boolean;
  2327. begin
  2328. Result := False;
  2329. {CC2: This is one of the few cases where the server can return only "OK completed"
  2330. meaning that the user has no mailboxes.}
  2331. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2332. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdList] + ' "" *' ), [IMAP4Commands[cmdList]] ); {Do not Localize}
  2333. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2334. ParseListResult ( AMailBoxList, LastCmdResult.Text );
  2335. Result := True;
  2336. end;
  2337. end else begin
  2338. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2339. end;
  2340. end;
  2341. function TIdIMAP4.ListInferiorMailBoxes(AMailBoxList, AInferiorMailBoxList: TIdStringList): Boolean;
  2342. var Ln : Integer;
  2343. LAuxMailBoxList : TIdStringList;
  2344. begin
  2345. Result := False;
  2346. {CC2: This is one of the few cases where the server can return only "OK completed"
  2347. meaning that the user has no inferior mailboxes.}
  2348. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2349. if ( AMailBoxList = nil ) then begin
  2350. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdList] + ' "" %' ), [IMAP4Commands[cmdList]] ); {Do not Localize}
  2351. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2352. ParseListResult ( AInferiorMailBoxList, LastCmdResult.Text );
  2353. //The INBOX mailbox is added because I think it always has to exist
  2354. //in an IMAP4 account (default) but it does not list it in this command.
  2355. {AInferiorMailBoxList.Add ( 'INBOX' ); {Do not Localize}
  2356. Result := True;
  2357. end;
  2358. end else begin
  2359. LAuxMailBoxList := TIdStringList.Create;
  2360. try
  2361. AInferiorMailBoxList.Clear;
  2362. for Ln := 0 to ( AMailBoxList.Count - 1 ) do begin
  2363. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdList] + ' "" "' + {Do not Localize}
  2364. AMailBoxList[Ln] + FMailBoxSeparator + '%"' ), [IMAP4Commands[cmdList]] ); {Do not Localize}
  2365. if ( LastCmdResult.Code = IMAP_OK ) then begin
  2366. ParseListResult ( LAuxMailBoxList, LastCmdResult.Text );
  2367. AInferiorMailBoxList.AddStrings ( LAuxMailBoxList );
  2368. Result := True;
  2369. end else begin
  2370. Break;
  2371. end;
  2372. end;
  2373. finally
  2374. LAuxMailBoxList.Free;
  2375. end;
  2376. end;
  2377. end else begin
  2378. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2379. end;
  2380. end;
  2381. function TIdIMAP4.ListSubscribedMailBoxes(AMailBoxList: TIdStringList): Boolean;
  2382. begin
  2383. {CC2: This is one of the few cases where the server can return only "OK completed"
  2384. meaning that the user has no subscribed mailboxes.}
  2385. Result := False;
  2386. if ((FConnectionState = csAuthenticated) or (FConnectionState = csSelected)) then begin
  2387. SendCmd(NewCmdCounter, (IMAP4Commands[cmdLSub] + ' "" *'), [IMAP4Commands[cmdList], IMAP4Commands[cmdLSub]] ); {Do not Localize}
  2388. if (LastCmdResult.Code = IMAP_OK) then begin
  2389. // ds - fixed bug # 506026
  2390. ParseLSubResult(AMailBoxList, LastCmdResult.Text);
  2391. Result := True;
  2392. end;
  2393. end else begin
  2394. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
  2395. end;
  2396. end;
  2397. function TIdIMAP4.StoreFlags(const AMsgNumList: array of Integer;
  2398. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  2399. var LDataItem,
  2400. LMsgSet,
  2401. LFlags : String;
  2402. begin
  2403. Result := False;
  2404. if ( Length ( AMsgNumList ) = 0 ) then begin
  2405. Exit;
  2406. end;
  2407. LMsgSet := ArrayToNumberStr ( AMsgNumList );
  2408. case AStoreMethod of
  2409. sdReplace: LDataItem := IMAP4StoreDataItem[sdReplaceSilent];
  2410. sdAdd: LDataItem := IMAP4StoreDataItem[sdAddSilent];
  2411. sdRemove: LDataItem := IMAP4StoreDataItem[sdRemoveSilent];
  2412. end;
  2413. LFlags := MessageFlagSetToStr(AFlags);
  2414. if ( FConnectionState = csSelected ) then begin
  2415. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdStore] + ' ' + LMsgSet + ' ' + {Do not Localize}
  2416. LDataItem + ' (' + Trim ( LFlags ) + ')' ), [] ); {Do not Localize}
  2417. if LastCmdResult.Code = IMAP_OK then begin
  2418. Result := True;
  2419. end;
  2420. end else begin
  2421. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2422. end;
  2423. end;
  2424. function TIdIMAP4.UIDStoreFlags (const AMsgUID: String;
  2425. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  2426. var LDataItem,
  2427. LFlags : String;
  2428. begin
  2429. Result := False;
  2430. IsUIDValid(AMsgUID);
  2431. case AStoreMethod of
  2432. sdReplace: LDataItem := IMAP4StoreDataItem[sdReplaceSilent];
  2433. sdAdd: LDataItem := IMAP4StoreDataItem[sdAddSilent];
  2434. sdRemove: LDataItem := IMAP4StoreDataItem[sdRemoveSilent];
  2435. end;
  2436. LFlags := MessageFlagSetToStr(AFlags);
  2437. if ( FConnectionState = csSelected ) then begin
  2438. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdStore] + ' ' + {Do not Localize}
  2439. AMsgUID + ' ' + LDataItem + ' (' + Trim ( LFlags ) + ')' ), [] ); {Do not Localize}
  2440. if LastCmdResult.Code = IMAP_OK then begin
  2441. Result := True;
  2442. end;
  2443. end else begin
  2444. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2445. end;
  2446. end;
  2447. function TIdIMAP4.UIDStoreFlags (const AMsgUIDList: array of String;
  2448. const AStoreMethod: TIdIMAP4StoreDataItem; const AFlags: TIdMessageFlagsSet): Boolean;
  2449. var LDataItem,
  2450. LMsgSet,
  2451. LFlags : String;
  2452. LN: integer;
  2453. begin
  2454. Result := False;
  2455. LMsgSet := '';
  2456. for LN := 0 to Length(AMsgUIDList) -1 do begin
  2457. IsUIDValid(AMsgUIDList[LN]);
  2458. if LN > 0 then begin
  2459. LMsgSet := LMsgSet + ','; {Do not Localize}
  2460. end;
  2461. LMsgSet := LMsgSet+AMsgUIDList[LN];
  2462. end;
  2463. case AStoreMethod of
  2464. sdReplace: LDataItem := IMAP4StoreDataItem[sdReplaceSilent];
  2465. sdAdd: LDataItem := IMAP4StoreDataItem[sdAddSilent];
  2466. sdRemove: LDataItem := IMAP4StoreDataItem[sdRemoveSilent];
  2467. end;
  2468. LFlags := MessageFlagSetToStr(AFlags);
  2469. if ( FConnectionState = csSelected ) then begin
  2470. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdStore] + ' ' + {Do not Localize}
  2471. LMsgSet + ' ' + LDataItem + ' (' + Trim ( LFlags ) + ')' ), [] ); {Do not Localize}
  2472. if LastCmdResult.Code = IMAP_OK then begin
  2473. Result := True;
  2474. end;
  2475. end else begin
  2476. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2477. end;
  2478. end;
  2479. function TIdIMAP4.CopyMsgs(const AMsgNumList: array of Integer; const AMBName: String): Boolean;
  2480. var LMsgSet : String;
  2481. begin
  2482. Result := False;
  2483. if ( Length ( AMsgNumList ) = 0 ) then begin
  2484. Exit;
  2485. end;
  2486. LMsgSet := ArrayToNumberStr ( AMsgNumList );
  2487. if ( FConnectionState = csSelected ) then begin
  2488. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdCopy] + ' ' + LMsgSet + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2489. if LastCmdResult.Code = IMAP_OK then begin
  2490. Result := True;
  2491. end;
  2492. end else begin
  2493. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2494. end;
  2495. end;
  2496. function TIdIMAP4.UIDCopyMsgs(const AMsgUIDList: TIdStringList; const AMBName: String): Boolean;
  2497. var LCmd : String;
  2498. LN: integer;
  2499. begin
  2500. Result := False;
  2501. if ( AMsgUIDList.Count = 0 ) then begin
  2502. Exit;
  2503. end;
  2504. LCmd := IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdCopy] + ' '; {Do not Localize}
  2505. for LN := 0 to AMsgUIDList.Count-1 do begin
  2506. if LN = 0 then begin
  2507. LCmd := LCmd + AMsgUIDList.Strings[LN];
  2508. end else begin
  2509. LCmd := LCmd + ',' + AMsgUIDList.Strings[LN]; {Do not Localize}
  2510. end;
  2511. end;
  2512. LCmd := LCmd + ' "' + DoMUTFEncode(AMBName) + '"'; {Do not Localize}
  2513. if ( FConnectionState = csSelected ) then begin
  2514. {SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdCopy] + ' ' + LMsgSet + ' "' + AMBName + '"' ) ); {Do not Localize}
  2515. SendCmd ( NewCmdCounter, LCmd, [] );
  2516. if LastCmdResult.Code = IMAP_OK then begin
  2517. Result := True;
  2518. end;
  2519. end else begin
  2520. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2521. end;
  2522. end;
  2523. function TIdIMAP4.CopyMsg (const AMsgNum: Integer; const AMBName: String): Boolean;
  2524. //Copies a message from the current selected mailbox to the specified mailbox. {Do not Localize}
  2525. begin
  2526. Result := False;
  2527. IsNumberValid(AMsgNum);
  2528. if ( FConnectionState = csSelected ) then begin
  2529. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdCopy] + ' ' + IntToStr(AMsgNum) + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2530. if LastCmdResult.Code = IMAP_OK then begin
  2531. Result := True;
  2532. end;
  2533. end else begin
  2534. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2535. end;
  2536. end;
  2537. function TIdIMAP4.UIDCopyMsg (const AMsgUID: String; const AMBName: String): Boolean;
  2538. //Copies a message from the current selected mailbox to the specified mailbox. {Do not Localize}
  2539. begin
  2540. Result := False;
  2541. IsUIDValid(AMsgUID);
  2542. if ( FConnectionState = csSelected ) then begin
  2543. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdCopy] + ' ' + AMsgUID + ' "' + DoMUTFEncode(AMBName) + '"' ), [] ); {Do not Localize}
  2544. if LastCmdResult.Code = IMAP_OK then begin
  2545. Result := True;
  2546. end;
  2547. end else begin
  2548. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2549. end;
  2550. end;
  2551. function TIdIMAP4.AppendMsg(const AMBName: String; AMsg: TIdMessage; const AFlags: TIdMessageFlagsSet = []): Boolean;
  2552. begin
  2553. Result := AppendMsg(AMBName, AMsg, nil, AFlags);
  2554. end;
  2555. function TIdIMAP4.AppendMsg (const AMBName: String; AMsg: TIdMessage; AAlternativeHeaders: TIdHeaderList; const AFlags: TIdMessageFlagsSet = []): Boolean;
  2556. var LFlags,
  2557. LMsgLiteral: String;
  2558. Ln: Integer;
  2559. LCmd: string;
  2560. LLength: integer;
  2561. LHeadersAsString: string;
  2562. LText: TextFile;
  2563. LTempPathname: string;
  2564. LDestStream: TIdTCPStream;
  2565. LSourceStream: TFileStream;
  2566. LLengthOfAMsgHeaders: integer;
  2567. LLengthOfFileHeaders: integer;
  2568. LLine: string;
  2569. LIdSourceStream: TIdStreamVCL;
  2570. {$IFDEF DOTNET}
  2571. LSearchRec: TSearchRec;
  2572. {$ELSE}
  2573. LByte: file of Byte;
  2574. {$ENDIF}
  2575. begin
  2576. Result := False;
  2577. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2578. if ( {Assigned (AMsg) and} ( AMBName <> '' ) ) then begin {Do not Localize}
  2579. LFlags := MessageFlagSetToStr(AFlags);
  2580. if ( LFlags <> '' ) then begin {Do not Localize}
  2581. LFlags := '(' + Trim (LFlags) + ')'; {Do not Localize}
  2582. end;
  2583. {We are better off making up the headers as a string first rather than predicting
  2584. its length. Slightly wasteful of memory, but it will not take up much.}
  2585. LHeadersAsString := ''; {Do not Localize}
  2586. if AAlternativeHeaders = nil then begin
  2587. {Use the headers that are in the message AMsg...}
  2588. for Ln := 0 to Pred (AMsg.Headers.Count) do begin
  2589. LHeadersAsString := LHeadersAsString + AMsg.Headers[Ln] + EOL; {Do not Localize}
  2590. end;
  2591. for Ln := 0 to Pred (AMsg.ExtraHeaders.Count) do begin
  2592. LHeadersAsString := LHeadersAsString + AMsg.ExtraHeaders[Ln] + EOL; {Do not Localize}
  2593. end;
  2594. end else begin
  2595. {Note AAlternativeHeaders is probably IdSMTP's LastGeneratedHeaders,
  2596. which would include the ExtraHeaders field.}
  2597. {Use the headers that the user has passed to us...}
  2598. for Ln := 0 to Pred (AAlternativeHeaders.Count) do begin
  2599. LHeadersAsString := LHeadersAsString + AAlternativeHeaders[Ln] + EOL; {Do not Localize}
  2600. end;
  2601. end;
  2602. LLengthOfAMsgHeaders := Length(LHeadersAsString);
  2603. {CC8: In Indy 10, we want to support attachments (previous versions did
  2604. not). The problem is that we have to know the size of the message
  2605. in advance of sending it for the IMAP APPEND command.
  2606. The problem is that there is no way of calculating the size of a
  2607. message without generating the encoded message. Therefore, write the
  2608. message out to a temporary file, and then get the size of the file,
  2609. which with a bit of adjustment, will give us the size of the message
  2610. we will send.
  2611. The "adjustment" is necessary because SaveToFile generates it's own
  2612. headers, which will be different to both the ones in AMsg and
  2613. AAlternativeHeaders, in the Date header, if nothing else.}
  2614. LTempPathname := MakeTempFilename;
  2615. AMsg.SaveToFile(LTempPathname);
  2616. {$IFDEF DOTNET}
  2617. {Get the size of the file...}
  2618. if FindFirst(LTempPathname, faAnyFile, LSearchRec) <> 0 then begin
  2619. {TODO: Throw an exception, the file we just saved is not present...}
  2620. end;
  2621. LLength := LSearchRec.Size;
  2622. {$ELSE}
  2623. {Get the size of the file, have to open it as a file of bytes
  2624. to do this...}
  2625. AssignFile(LByte, LTempPathname);
  2626. Reset(LByte);
  2627. LLength := FileSize(LByte);
  2628. CloseFile(LByte);
  2629. {$ENDIF}
  2630. {Get the size of the headers (by opening it as a text file) which
  2631. SaveToFile may have generated, and will be different from the ones
  2632. in AMsg...}
  2633. AssignFile(LText, LTempPathname);
  2634. Reset(LText);
  2635. LLengthOfFileHeaders := 0;
  2636. while True do begin
  2637. Readln(LText, LLine);
  2638. if LLine = '' then break;
  2639. LLengthOfFileHeaders := LLengthOfFileHeaders + Length(LLine) + 2;
  2640. end;
  2641. CloseFile(LText);
  2642. {We have to subtract the size of the headers in the file and
  2643. add back the size of the headers we are to use
  2644. to get the size of the message we are going to send...}
  2645. LLength := LLength - LLengthOfFileHeaders + LLengthOfAMsgHeaders;
  2646. {Some servers may want the message termination sequence CRLF.CRLF
  2647. and some may want CRLFCRLF so pass both by using CRLF.CRLFCRLF}
  2648. LLength := LLength + 2;
  2649. LMsgLiteral := '{' + IntToStr ( LLength ) + '}'; {Do not Localize}
  2650. {CC: The original code sent the APPEND command first, then followed it with the
  2651. message. Maybe this worked with some server, but most send a
  2652. response like "+ Send the additional command..." between the two,
  2653. which was not expected by the client and caused an exception.}
  2654. //CC: Added double quotes around mailbox name, else mailbox names with spaces will cause server parsing error
  2655. LCmd := IMAP4Commands[cmdAppend] + ' "' + AMBName + '" '; {Do not Localize}
  2656. if LFlags <> '' then begin {Do not Localize}
  2657. LCmd := LCmd + LFlags + ' '; {Do not Localize}
  2658. end;
  2659. LCmd := LCmd + LMsgLiteral; {Do not Localize}
  2660. {Used to add the message to LCmd here. Try sending the APPEND command, get
  2661. the + response, then send the message...}
  2662. SendCmd (NewCmdCounter, LCmd, []);
  2663. if LastCmdResult.Code = IMAP_CONT then begin
  2664. LDestStream := TIdTCPStream.Create(Self);
  2665. if assigned(FOnWorkForPart) then begin
  2666. LDestStream.Connection.OnWork := FOnWorkForPart;
  2667. end;
  2668. if assigned(FOnWorkBeginForPart) then begin
  2669. LDestStream.Connection.OnWorkBegin := FOnWorkBeginForPart;
  2670. end;
  2671. if assigned(FOnWorkEndForPart) then begin
  2672. LDestStream.Connection.OnWorkEnd := FOnWorkEndForPart;
  2673. end;
  2674. LSourceStream := TFileStream.Create(LTempPathname, fmOpenRead);
  2675. LDestStream.Write(LHeadersAsString);
  2676. //Change from CopyFrom to WriteStream (I think) to get OnWork invoked, as we do elsewhere
  2677. //with LSourceStream.Connection.IOHandler.ReadStream(LUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  2678. //LDestStream.CopyFrom(LSourceStream, LSourceStream.Size - LLengthOfFileHeaders);
  2679. {TODO #DONE#: What is the DotNet version?}
  2680. LIdSourceStream := TIdStreamVCL.Create(LSourceStream);
  2681. //LSourceStream.Position := LLengthOfFileHeaders;
  2682. //LIdSourceStream.Stream.Position := LLengthOfFileHeaders;
  2683. LIdSourceStream.VCLStream.Position := LLengthOfFileHeaders;
  2684. //LDestStream.Connection.IOHandler.Write(LIdSourceStream, LIdSourceStream.Stream.Size - LLengthOfFileHeaders);
  2685. LDestStream.Connection.IOHandler.Write(LIdSourceStream, LIdSourceStream.VCLStream.Size - LLengthOfFileHeaders);
  2686. {Adding another CRLF so that the ending is CRLF.CRLFCRLF}
  2687. LLine := EOL;
  2688. LDestStream.Write(LLine);
  2689. {WARNING: After we send the message (which should be exactly
  2690. LLength bytes long), we need to send an EXTRA CRLF which is in
  2691. addition to to count in LLength, because this CRLF terminates the
  2692. APPEND command...}
  2693. LDestStream.Write(LLine);
  2694. LSourceStream.Free;
  2695. LDestStream.Free;
  2696. {$IFDEF DOTNET}
  2697. LIdSourceStream.Free;
  2698. {$ENDIF}
  2699. {Delete the file, don't need it anymore...}
  2700. DeleteFile(LTempPathname);
  2701. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdAppend]], False) = IMAP_OK then begin
  2702. Result := True;
  2703. end;
  2704. end;
  2705. end;
  2706. end else begin
  2707. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2708. end;
  2709. end;
  2710. function TIdIMAP4.AppendMsgNoEncodeFromFile (const AMBName: String; ASourceFile: string; const AFlags: TIdMessageFlagsSet = []): Boolean;
  2711. var
  2712. LSourceStream: TFileStream;
  2713. begin
  2714. LSourceStream := TFileStream.Create(ASourceFile, fmOpenRead);
  2715. Result := AppendMsgNoEncodeFromStream(AMBName, LSourceStream, AFlags);
  2716. LSourceStream.Free;
  2717. end;
  2718. function TIdIMAP4.AppendMsgNoEncodeFromStream (const AMBName: String; AStream: TStream; const AFlags: TIdMessageFlagsSet = []): Boolean;
  2719. var LFlags,
  2720. LMsgLiteral: String;
  2721. Ln: Integer;
  2722. LCmd: string;
  2723. LLength: integer;
  2724. LDestStream: TIdTCPStream;
  2725. LTempStream: TMemoryStream;
  2726. LIdTempStream: TIdStreamVCL;
  2727. LTheBytes: TIdBytes;
  2728. begin
  2729. Result := False;
  2730. if ( ( FConnectionState = csAuthenticated ) or ( FConnectionState = csSelected ) ) then begin
  2731. if AMBName <> '' then begin {Do not Localize}
  2732. LFlags := MessageFlagSetToStr(AFlags);
  2733. if ( LFlags <> '' ) then begin {Do not Localize}
  2734. LFlags := '(' + Trim (LFlags) + ')'; {Do not Localize}
  2735. end;
  2736. LLength := AStream.Size;
  2737. LTempStream := TMemoryStream.Create;
  2738. LIdTempStream := TIdStreamVCL.Create(LTempStream);
  2739. //Hunt for CRLF.CRLF, if present then we need to remove it...
  2740. SetLength(LTheBytes, 1);
  2741. LIdTempStream.VCLStream.CopyFrom(AStream, LLength);
  2742. for LN := 0 to LIdTempStream.Size-5 do begin
  2743. LIdTempStream.ReadBytes(LTheBytes, 1, LN);
  2744. if LTheBytes[0] <> 13 then begin
  2745. continue;
  2746. end;
  2747. LIdTempStream.ReadBytes(LTheBytes, 1, LN+1);
  2748. if LTheBytes[0] <> 10 then begin
  2749. continue;
  2750. end;
  2751. LIdTempStream.ReadBytes(LTheBytes, 1, LN+2);
  2752. if LTheBytes[0] <> Ord('.') then begin
  2753. continue;
  2754. end;
  2755. LIdTempStream.ReadBytes(LTheBytes, 1, LN+3);
  2756. if LTheBytes[0] <> 13 then begin
  2757. continue;
  2758. end;
  2759. LIdTempStream.ReadBytes(LTheBytes, 1, LN+4);
  2760. if LTheBytes[0] <> 10 then begin
  2761. continue;
  2762. end;
  2763. //Found it.
  2764. LLength := LN;
  2765. end;
  2766. {Some servers may want the message termination sequence CRLF.CRLF
  2767. and some may want CRLFCRLF so pass both by using CRLF.CRLFCRLF}
  2768. LLength := LLength + 2;
  2769. LMsgLiteral := '{' + IntToStr ( LLength ) + '}'; {Do not Localize}
  2770. {CC: The original code sent the APPEND command first, then followed it with the
  2771. message. Maybe this worked with some server, but most send a
  2772. response like "+ Send the additional command..." between the two,
  2773. which was not expected by the client and caused an exception.}
  2774. //CC: Added double quotes around mailbox name, else mailbox names with spaces will cause server parsing error
  2775. LCmd := IMAP4Commands[cmdAppend] + ' "' + AMBName + '" '; {Do not Localize}
  2776. if LFlags <> '' then begin {Do not Localize}
  2777. LCmd := LCmd + LFlags + ' '; {Do not Localize}
  2778. end;
  2779. LCmd := LCmd + LMsgLiteral; {Do not Localize}
  2780. {Used to add the message to LCmd here. Try sending the APPEND command, get
  2781. the + response, then send the message...}
  2782. SendCmd (NewCmdCounter, LCmd, []);
  2783. if LastCmdResult.Code = IMAP_CONT then begin
  2784. LDestStream := TIdTCPStream.Create(Self);
  2785. if assigned(FOnWorkForPart) then begin
  2786. LDestStream.Connection.OnWork := FOnWorkForPart;
  2787. end;
  2788. if assigned(FOnWorkBeginForPart) then begin
  2789. LDestStream.Connection.OnWorkBegin := FOnWorkBeginForPart;
  2790. end;
  2791. if assigned(FOnWorkEndForPart) then begin
  2792. LDestStream.Connection.OnWorkEnd := FOnWorkEndForPart;
  2793. end;
  2794. //LSourceStream := TFileStream.Create(LTempPathname, fmOpenRead);
  2795. //LDestStream.Write(LHeadersAsString);
  2796. LDestStream.Connection.IOHandler.Write(LIdTempStream, LLength);
  2797. SetLength(LTheBytes, 7);
  2798. LTheBytes[0] := 13;
  2799. LTheBytes[1] := 10;
  2800. LTheBytes[2] := Ord('.');
  2801. LTheBytes[3] := 13;
  2802. LTheBytes[4] := 10;
  2803. LTheBytes[5] := 13;
  2804. LTheBytes[6] := 10;
  2805. LDestStream.Connection.IOHandler.WriteDirect(LTheBytes);
  2806. {WARNING: After we send the message (which should be exactly
  2807. LLength bytes long), we need to send an EXTRA CRLF which is in
  2808. addition to to count in LLength, because this CRLF terminates the
  2809. APPEND command...}
  2810. SetLength(LTheBytes, 2); //Should truncate LTheBytes to just a CRLF
  2811. LDestStream.Connection.IOHandler.WriteDirect(LTheBytes);
  2812. LDestStream.Free;
  2813. if GetInternalResponse(LastCmdCounter, [IMAP4Commands[cmdAppend]], False) = IMAP_OK then begin
  2814. Result := True;
  2815. end;
  2816. end;
  2817. LTempStream.Free;
  2818. LIdTempStream.Free;
  2819. end;
  2820. end else begin
  2821. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2822. end;
  2823. end;
  2824. function TIdIMAP4.RetrieveEnvelope(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  2825. begin
  2826. Result := InternalRetrieveEnvelope(AMsgNum, AMsg, nil);
  2827. end;
  2828. function TIdIMAP4.RetrieveEnvelopeRaw(const AMsgNum: Integer; ADestList: TIdStringList): Boolean;
  2829. begin
  2830. Result := InternalRetrieveEnvelope(AMsgNum, nil, ADestList);
  2831. end;
  2832. function TIdIMAP4.InternalRetrieveEnvelope(const AMsgNum: Integer; AMsg: TIdMessage; ADestList: TIdStringList): Boolean;
  2833. //var
  2834. // LSlRetrieve : TIdStringList;
  2835. // LStr: String;
  2836. // Ln: Integer;
  2837. begin
  2838. {CC2: Return False if message number is invalid...}
  2839. IsNumberValid(AMsgNum);
  2840. Result := False;
  2841. if ( FConnectionState = csSelected ) then begin
  2842. //LSlRetrieve := TIdStringList.Create;
  2843. //try
  2844. {Some servers return NO if the requested message number is not present
  2845. (e.g. Cyrus), others return OK but no data (CommuniGate).}
  2846. SendCmd (NewCmdCounter, ( IMAP4Commands[cmdFetch] + ' ' + {Do not Localize}
  2847. IntToStr ( AMsgNum ) + ' (' + {Do not Localize}
  2848. IMAP4FetchDataItem[fdEnvelope] + ')'), [IMAP4Commands[cmdFetch]] ); {Do not Localize}
  2849. if LastCmdResult.Code = IMAP_OK then begin
  2850. { if LastCmdResult.Text.Count > 0 then begin
  2851. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  2852. { end;
  2853. {CC: Make sure we have enough words}
  2854. { if ( (LSlRetrieve.Count > 2) and
  2855. //{$IFDEF INDY100}
  2856. { (TextIsSame(LSlRetrieve[0], IntToStr ( AMsgNum ))) and
  2857. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  2858. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdEnvelope])) ) then begin {Do not Localize}
  2859. //{$ELSE}
  2860. { (AnsiSameText(LSlRetrieve[0], IntToStr ( AMsgNum ))) and
  2861. (AnsiSameText(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  2862. (AnsiSameText(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdEnvelope])) ) then begin {Do not Localize}
  2863. //{$ENDIF}
  2864. { LStr := Copy ( LastCmdResult.Text[0],
  2865. ( Pos ( IMAP4FetchDataItem[fdEnvelope] + ' (', LastCmdResult.Text[0] ) + {Do not Localize}
  2866. { Length ( IMAP4FetchDataItem[fdEnvelope] + ' (' ) ), {Do not Localize}
  2867. { Length ( LastCmdResult.Text[0] ) );
  2868. }
  2869. //{$IFDEF INDY100}
  2870. { if ( LastCmdResult.Text.Count > 1 ) then begin
  2871. for Ln := 1 to LastCmdResult.Text.Count - 1 do begin
  2872. LStr := LStr + LastCmdResult.Text[Ln];
  2873. end;
  2874. end;
  2875. }
  2876. //{$ELSE}
  2877. { if ( LastCmdResult.Text.Count > 2 ) then begin
  2878. for Ln := 1 to Pred (Pred (LastCmdResult.Text.Count)) do begin
  2879. LStr := LStr + LastCmdResult.Text[Ln];
  2880. end;
  2881. end;
  2882. }
  2883. //{$ENDIF}
  2884. // LStr := Copy (LStr, 1, Length (LStr) - 2);
  2885. {CC6: Altered to support Raw option...}
  2886. { if ADestList <> nil then begin
  2887. ADestList.Clear;
  2888. for Ln := 0 to LastCmdResult.Text.Count - 1 do begin
  2889. ADestList.Add(LastCmdResult.Text[Ln]);
  2890. end;
  2891. end;
  2892. if AMsg <> nil then begin
  2893. ParseEnvelopeResult (AMsg, LStr);
  2894. end;
  2895. {CC2: Only return True if get to here, a valid response...}
  2896. { Result := True; {LastCmdResult.NumericCode = wsOk;}
  2897. // end;
  2898. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) = True then begin
  2899. if ADestList <> nil then begin
  2900. ADestList.Clear;
  2901. ADestList.Add(FLineStruct.IMAPValue);
  2902. end;
  2903. if AMsg <> nil then begin
  2904. ParseEnvelopeResult (AMsg, FLineStruct.IMAPValue);
  2905. end;
  2906. Result := True;
  2907. end;
  2908. end;
  2909. //finally
  2910. //LSlRetrieve.Free;
  2911. //end;
  2912. end else begin
  2913. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  2914. end;
  2915. end;
  2916. function TIdIMAP4.UIDRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  2917. begin
  2918. Result := UIDInternalRetrieveEnvelope(AMsgUID, AMsg, nil);
  2919. end;
  2920. function TIdIMAP4.UIDRetrieveEnvelopeRaw(const AMsgUID: String; ADestList: TIdStringList): Boolean;
  2921. begin
  2922. Result := UIDInternalRetrieveEnvelope(AMsgUID, nil, ADestList);
  2923. end;
  2924. function TIdIMAP4.UIDInternalRetrieveEnvelope(const AMsgUID: String; AMsg: TIdMessage; ADestList: TIdStringList): Boolean;
  2925. //var LSlRetrieve : TIdStringList;
  2926. // LStr: String;
  2927. // Ln: Integer;
  2928. begin
  2929. IsUIDValid(AMsgUID);
  2930. {CC2: Return False if message number is invalid...}
  2931. Result := False;
  2932. if ( FConnectionState = csSelected ) then begin
  2933. //LSlRetrieve := TIdStringList.Create;
  2934. //try
  2935. {Some servers return NO if the requested message number is not present
  2936. (e.g. Cyrus), others return OK but no data (CommuniGate).}
  2937. SendCmd (NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + {Do not Localize}
  2938. AMsgUID + ' (' + IMAP4FetchDataItem[fdEnvelope] + ')'), [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]] ); {Do not Localize}
  2939. if LastCmdResult.Code = IMAP_OK then begin
  2940. { if LastCmdResult.Text.Count > 0 then begin
  2941. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  2942. { end;
  2943. {CC: Make sure we have enough words}
  2944. {CC2: Sort out correct server response...}
  2945. // if LSlRetrieve.Count > 4 then begin
  2946. //{$IFDEF INDY100}
  2947. { if ( ( (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  2948. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdEnvelope])) {Do not Localize}
  2949. { ) or (
  2950. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  2951. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdUid])) and {Do not Localize}
  2952. { (TextIsSame(LSlRetrieve[4], IMAP4FetchDataItem[fdEnvelope]))
  2953. }
  2954. //{$ELSE}
  2955. { if ( ( (AnsiSameText( LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  2956. (AnsiSameText( LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdEnvelope])) {Do not Localize}
  2957. { ) or (
  2958. (AnsiSameText( LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  2959. (AnsiSameText( LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdUid])) and {Do not Localize}
  2960. { (AnsiSameText( LSlRetrieve[4], IMAP4FetchDataItem[fdEnvelope]))
  2961. }
  2962. //{$ENDIF}
  2963. { ) ) then begin
  2964. LStr := Copy ( LastCmdResult.Text[0],
  2965. ( Pos ( IMAP4FetchDataItem[fdEnvelope] + ' (', LastCmdResult.Text[0] ) + {Do not Localize}
  2966. { Length ( IMAP4FetchDataItem[fdEnvelope] + ' (' ) ), {Do not Localize}
  2967. { Length ( LastCmdResult.Text[0] ) );
  2968. }
  2969. //{$IFDEF INDY100}
  2970. { if ( LastCmdResult.Text.Count > 1 ) then begin
  2971. for Ln := 1 to LastCmdResult.Text.Count - 1 do begin
  2972. LStr := LStr + LastCmdResult.Text[Ln];
  2973. end;
  2974. end;
  2975. }
  2976. //{$ELSE}
  2977. { if ( LastCmdResult.Text.Count > 2 ) then begin
  2978. for Ln := 1 to Pred (Pred (LastCmdResult.Text.Count)) do begin
  2979. LStr := LStr + LastCmdResult.Text[Ln];
  2980. end;
  2981. end;
  2982. }
  2983. //{$ENDIF}
  2984. { LStr := Copy (LStr, 1, Length (LStr) - 2);
  2985. {CC6: Altered to support Raw option...}
  2986. { if ADestList <> nil then begin
  2987. ADestList.Clear;
  2988. for Ln := 0 to LastCmdResult.Text.Count-1 do begin
  2989. ADestList.Add(LastCmdResult.Text[Ln]);
  2990. end;
  2991. end;
  2992. if AMsg <> nil then begin
  2993. ParseEnvelopeResult (AMsg, LStr);
  2994. end;
  2995. {CC2: Only return True if get to here, a valid response...}
  2996. { Result := True;
  2997. end;
  2998. end;
  2999. }
  3000. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) = True then begin
  3001. if ADestList <> nil then begin
  3002. ADestList.Clear;
  3003. ADestList.Add(FLineStruct.IMAPValue);
  3004. end;
  3005. if AMsg <> nil then begin
  3006. ParseEnvelopeResult (AMsg, FLineStruct.IMAPValue);
  3007. end;
  3008. Result := True;
  3009. end;
  3010. end;
  3011. //finally
  3012. //LSlRetrieve.Free;
  3013. //end;
  3014. end else begin
  3015. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3016. end;
  3017. end;
  3018. function TIdIMAP4.RetrieveAllEnvelopes(AMsgList: TIdMessageCollection): Boolean;
  3019. {NOTE: If AMsgList is empty or does not have enough records, records will be added.
  3020. If you pass a non-empty AMsgList, it is assumed the records are in relative record
  3021. number sequence: if not, pass in an empty AMsgList and copy the results to your
  3022. own AMsgList.}
  3023. var
  3024. Ln: Integer;
  3025. LMsgItem: TIdMessageItem;
  3026. begin
  3027. Result := False;
  3028. {CC2: This is one of the few cases where the server can return only "OK completed"
  3029. meaning that the user has no envelopes.}
  3030. if ( FConnectionState = csSelected ) then begin
  3031. SendCmd (NewCmdCounter, ( IMAP4Commands[cmdFetch] + ' 1:* (' + {Do not Localize}
  3032. IMAP4FetchDataItem[fdEnvelope] + ')'), [] ); {Do not Localize}
  3033. if LastCmdResult.Code = IMAP_OK then begin
  3034. for Ln := 0 to LastCmdResult.Text.Count-1 do begin
  3035. if ParseLastCmdResult(LastCmdResult.Text[Ln], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) = True then begin
  3036. if LN >= AMsgList.Count then begin
  3037. LMsgItem := AMsgList.Add;
  3038. ParseEnvelopeResult (LMsgItem.Msg, FLineStruct.IMAPValue);
  3039. end else begin
  3040. ParseEnvelopeResult (AMsgList.Messages[LN], FLineStruct.IMAPValue);
  3041. end;
  3042. end;
  3043. end;
  3044. Result := True;
  3045. end;
  3046. end else begin
  3047. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3048. end;
  3049. end;
  3050. function TIdIMAP4.UIDRetrieveAllEnvelopes(AMsgList: TIdMessageCollection): Boolean;
  3051. {NOTE: If AMsgList is empty or does not have enough records, records will be added.
  3052. If you pass a non-empty AMsgList, it is assumed the records are in relative record
  3053. number sequence: if not, pass in an empty AMsgList and copy the results to your
  3054. own AMsgList.}
  3055. var
  3056. Ln: Integer;
  3057. LMsgItem: TIdMessageItem;
  3058. begin
  3059. Result := False;
  3060. {CC2: This is one of the few cases where the server can return only "OK completed"
  3061. meaning that the user has no envelopes.}
  3062. if ( FConnectionState = csSelected ) then begin
  3063. SendCmd (NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' 1:* (' + {Do not Localize}
  3064. IMAP4FetchDataItem[fdEnvelope] + ')'), [] ); {Do not Localize}
  3065. if LastCmdResult.Code = IMAP_OK then begin
  3066. {Ln := 0;}
  3067. {while Ln < Pred (LastCmdResult.Text.Count) do}
  3068. for Ln := 0 to LastCmdResult.Text.Count-1 do begin
  3069. if ParseLastCmdResult(LastCmdResult.Text[Ln], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdEnvelope]]) = True then begin
  3070. if LN >= AMsgList.Count then begin
  3071. LMsgItem := AMsgList.Add;
  3072. ParseEnvelopeResult (LMsgItem.Msg, FLineStruct.IMAPValue);
  3073. LMsgItem.Msg.UID := FLineStruct.UID;
  3074. end else begin
  3075. ParseEnvelopeResult (AMsgList.Messages[LN], FLineStruct.IMAPValue);
  3076. AMsgList.Messages[LN].UID := FLineStruct.UID;
  3077. end;
  3078. end;
  3079. end;
  3080. Result := True;
  3081. end;
  3082. end else begin
  3083. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3084. end;
  3085. end;
  3086. function TIdIMAP4.RetrieveText(const AMsgNum: Integer; var AText: string): Boolean;
  3087. //Retrieve a specific individual part of a message
  3088. begin
  3089. IsNumberValid(AMsgNum);
  3090. Result := InternalRetrieveText(AMsgNum, AText, False, False, False);
  3091. end;
  3092. function TIdIMAP4.RetrieveText2(const AMsgNum: Integer; var AText: string): Boolean;
  3093. //Retrieve a specific individual part of a message
  3094. begin
  3095. IsNumberValid(AMsgNum);
  3096. Result := InternalRetrieveText(AMsgNum, AText, False, False, True);
  3097. end;
  3098. function TIdIMAP4.RetrieveTextPeek(const AMsgNum: Integer; var AText: string): Boolean;
  3099. {CC3: Added: Retrieve the text part of the message...}
  3100. begin
  3101. IsNumberValid(AMsgNum);
  3102. Result := InternalRetrieveText(AMsgNum, AText, False, True, False);
  3103. end;
  3104. function TIdIMAP4.RetrieveTextPeek2(const AMsgNum: Integer; var AText: string): Boolean;
  3105. {CC3: Added: Retrieve the text part of the message...}
  3106. begin
  3107. IsNumberValid(AMsgNum);
  3108. Result := InternalRetrieveText(AMsgNum, AText, False, True, True);
  3109. end;
  3110. function TIdIMAP4.UIDRetrieveText(const AMsgUID: String; var AText: string): Boolean;
  3111. {CC3: Added: Retrieve the text part of the message...}
  3112. begin
  3113. IsUIDValid(AMsgUID);
  3114. Result := InternalRetrieveText(StrToInt(AMsgUID), AText, True, False, False);
  3115. end;
  3116. function TIdIMAP4.UIDRetrieveText2(const AMsgUID: String; var AText: string): Boolean;
  3117. {CC3: Added: Retrieve the text part of the message...}
  3118. begin
  3119. IsUIDValid(AMsgUID);
  3120. Result := InternalRetrieveText(StrToInt(AMsgUID), AText, True, False, True);
  3121. end;
  3122. function TIdIMAP4.UIDRetrieveTextPeek(const AMsgUID: String; var AText: string): Boolean;
  3123. {CC3: Added: Retrieve the text part of the message...}
  3124. begin
  3125. IsUIDValid(AMsgUID);
  3126. Result := InternalRetrieveText(StrToInt(AMsgUID), AText, True, True, False);
  3127. end;
  3128. function TIdIMAP4.UIDRetrieveTextPeek2(const AMsgUID: String; var AText: string): Boolean;
  3129. {CC3: Added: Retrieve the text part of the message...}
  3130. begin
  3131. IsUIDValid(AMsgUID);
  3132. Result := InternalRetrieveText(StrToInt(AMsgUID), AText, True, True, True);
  3133. end;
  3134. function TIdIMAP4.InternalRetrieveText(const AMsgNum: Integer; var AText: string;
  3135. AUseUID: Boolean; AUsePeek: Boolean; AUseFirstPartInsteadOfText: Boolean): Boolean;
  3136. {CC3: Added: Retrieve the text part of the message...}
  3137. label TryAgain, UnexpectedResponse;
  3138. var
  3139. LSlRetrieve : TIdStringList;
  3140. LText: string;
  3141. LCmd: string;
  3142. LTextLength: Integer;
  3143. LParts: TIdImapMessageParts;
  3144. LThePart: TIdImapMessagePart;
  3145. LContentTransferEncoding: string;
  3146. LSourceStream: TIdTCPStream;
  3147. LBase64Decoder: TIdDecoderMIME;
  3148. LQuotedPrintableDecoder: TIdDecoderQuotedPrintable;
  3149. LTextPart: integer;
  3150. //{$IFDEF DOTNET}
  3151. //LBytes: TIdBytes;
  3152. //LBuffer: TIdBuffer;
  3153. LBuffer: TStringStream;
  3154. LIdBuffer: TIdStreamVCL;
  3155. //{$ENDIF}
  3156. begin
  3157. Result := False;
  3158. AText := ''; {Do not Localize}
  3159. if ( FConnectionState = csSelected ) then begin
  3160. LTextPart := 0; {The text part is usually part 1 but could be part 2}
  3161. if AUseFirstPartInsteadOfText = True then begin
  3162. {In this case, we need the body structure to find out what
  3163. encoding has been applied to part 1...}
  3164. LParts := TIdImapMessageParts.Create(nil, TIdImapMessagePart);
  3165. if AUseUID = True then begin
  3166. if UIDRetrieveStructure(IntToStr(AMsgNum), LParts) = False then Exit;
  3167. end else begin
  3168. if RetrieveStructure(AMsgNum, LParts) = False then Exit;
  3169. end;
  3170. {Get the info we want out of LParts...}
  3171. TryAgain:
  3172. LThePart := LParts.Items[LTextPart]; {Part 1 is index 0}
  3173. if LThePart.FSize = 0 then begin
  3174. {Some emails have part 0 empty, they intend you to use part 1}
  3175. if LTextPart = 0 then begin
  3176. LTextPart := 1;
  3177. goto TryAgain;
  3178. end;
  3179. end;
  3180. LContentTransferEncoding := LThePart.ContentTransferEncoding;
  3181. LParts.Destroy;
  3182. end;
  3183. LSlRetrieve := TIdStringList.Create;
  3184. try
  3185. LCmd := NewCmdCounter + ' '; {Do not Localize}
  3186. if AUseUID = True then begin
  3187. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  3188. end;
  3189. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + ' ('; {Do not Localize}
  3190. if AUsePeek = True then begin
  3191. LCmd := LCmd + IMAP4FetchDataItem[fdBody]+'.PEEK'; {Do not Localize}
  3192. end else begin
  3193. LCmd := LCmd + IMAP4FetchDataItem[fdBody];
  3194. end;
  3195. if AUseFirstPartInsteadOfText = False then begin
  3196. LCmd := LCmd + '[TEXT])'; {Do not Localize}
  3197. end else begin
  3198. LCmd := LCmd + '[' +IntToStr(LTextPart+1)+ '])'; {Do not Localize}
  3199. end;
  3200. WriteLn(LCmd);
  3201. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True ) = IMAP_OK ) then begin
  3202. {For an invalid request (non-existent part or message), NIL is returned as the size...}
  3203. if ( (ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch],
  3204. [IMAP4FetchDataItem[fdBody]+'['+'TEXT'+']' , IMAP4FetchDataItem[fdBody]+'['+IntToStr(LTextPart+1)+']']) = False) {do not localize}
  3205. or (UpperCase(FLineStruct.IMAPValue) = 'NIL') or (UpperCase(FLineStruct.IMAPValue) = '""') or (FLineStruct.ByteCount < 1) ) then begin {do not localize}
  3206. GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False );
  3207. Result := False;
  3208. end else begin
  3209. LTextLength := FLineStruct.ByteCount;
  3210. SetLength(LText, LTextLength);
  3211. LSourceStream := TIdTCPStream.Create(Self);
  3212. if Assigned(FOnWorkForPart) then begin
  3213. LSourceStream.Connection.OnWork := FOnWorkForPart;
  3214. end;
  3215. if Assigned(FOnWorkBeginForPart) then begin
  3216. LSourceStream.Connection.OnWorkBegin := FOnWorkBeginForPart;
  3217. end;
  3218. if Assigned(FOnWorkEndForPart) then begin
  3219. LSourceStream.Connection.OnWorkEnd := FOnWorkEndForPart;
  3220. end;
  3221. //{$IFDEF DOTNET}
  3222. //LBuffer := TIdBuffer.Create;
  3223. //SetLength(LBuffer, LTextLength);
  3224. //LSourceStream.Connection.IOHandler.ReadStream(LBuffer, LTextLength); //ReadStream uses OnWork, most other methods dont
  3225. //LText := LBuffer.Extract;
  3226. //LSourceStream.Connection.IOHandler.ReadStream(LText, LTextLength); //ReadStream uses OnWork, most other methods dont
  3227. LBuffer := TStringStream.Create('');
  3228. try
  3229. //TODO #DONE#: Recode LBuffer as a TIdStreamVCL...
  3230. LIdBuffer := TIdStreamVCL.Create(LBuffer);
  3231. try
  3232. LSourceStream.Connection.IOHandler.ReadStream(LIdBuffer, LTextLength); //ReadStream uses OnWork, most other methods dont
  3233. //LText := TStringStream(LIdBuffer.Stream).DataString;
  3234. LText := Copy(LBuffer.DataString, 1, LBuffer.Size);
  3235. LSourceStream.Free;
  3236. finally
  3237. LIdBuffer.Free;
  3238. end;
  3239. finally
  3240. LBuffer.Free;
  3241. end;
  3242. //{$ELSE}
  3243. // LSourceStream.ReadBuffer(LText[1], LTextLength);
  3244. // LSourceStream.Destroy;
  3245. //{$ENDIF}
  3246. if TextIsSame(LContentTransferEncoding, 'base64') then begin {Do not Localize}
  3247. LBase64Decoder := TIdDecoderMIME.Create(Self);
  3248. {Strip out any embedded CRLFs which are inserted by MTAs to ensure
  3249. the line-length limit is not exceeded...}
  3250. StripCRLFs(LText);
  3251. AText := LBase64Decoder.DecodeString(LText);
  3252. LBase64Decoder.Free;
  3253. end else if TextIsSame(LContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  3254. LQuotedPrintableDecoder := TIdDecoderQuotedPrintable.Create(Self);
  3255. AText := LQuotedPrintableDecoder.DecodeString(LText);
  3256. LQuotedPrintableDecoder.Free;
  3257. end else begin
  3258. AText := LText;
  3259. end;
  3260. ReadLnWait(); {Remove last line, ')' or 'UID 1)'}
  3261. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False ) = IMAP_OK then begin
  3262. {Only return TRUE if get to here...}
  3263. Result := True;
  3264. end;
  3265. end;
  3266. UnexpectedResponse:
  3267. end;
  3268. finally
  3269. LSlRetrieve.Free;
  3270. end;
  3271. end else begin
  3272. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3273. end;
  3274. end;
  3275. function TIdIMAP4.RetrieveStructure(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  3276. begin
  3277. IsNumberValid(AMsgNum);
  3278. Result := InternalRetrieveStructure(AMsgNum, AMsg, nil);
  3279. end;
  3280. function TIdIMAP4.RetrieveStructure(const AMsgNum: Integer; AParts: TIdImapMessageParts): Boolean;
  3281. begin
  3282. IsNumberValid(AMsgNum);
  3283. Result := InternalRetrieveStructure(AMsgNum, nil, AParts);
  3284. end;
  3285. function TIdIMAP4.InternalRetrieveStructure(const AMsgNum: Integer; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  3286. var
  3287. LSlRetrieve : TIdStringList;
  3288. LPartsList: TIdStringList;
  3289. LTheParts: TIdMessageParts;
  3290. begin
  3291. {CC2: Default to returning False at this point...}
  3292. Result := False;
  3293. LPartsList := TIdStringList.Create;
  3294. if ( FConnectionState = csSelected ) then begin
  3295. LSlRetrieve := TIdStringList.Create;
  3296. try
  3297. WriteLn ( NewCmdCounter + ' ' + ( {Do not Localize}
  3298. IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + ' (' + {Do not Localize}
  3299. IMAP4FetchDataItem[fdBodyStructure] + ')' ) ); {Do not Localize}
  3300. //if ( GetLineResponse ( GetCmdCounter ) = IMAP_OK ) then begin
  3301. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch]], True ) = IMAP_OK ) then begin
  3302. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], [IMAP4FetchDataItem[fdBodyStructure]]) = True then begin
  3303. if AMsg <> nil then begin
  3304. LTheParts := AMsg.MessageParts;
  3305. ParseBodyStructureResult(FLineStruct.IMAPValue, LTheParts, nil);
  3306. end;
  3307. if AParts <> nil then begin
  3308. ParseBodyStructureResult(FLineStruct.IMAPValue, nil, AParts);
  3309. end;
  3310. Result := True;
  3311. end;
  3312. end;
  3313. finally
  3314. LSlRetrieve.Free;
  3315. end;
  3316. end else begin
  3317. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3318. end;
  3319. LPartsList.Free;
  3320. end;
  3321. function TIdIMAP4.RetrievePart(const AMsgNum: Integer; const APartNum: Integer;
  3322. {$IFDEF DOTNET}
  3323. var ABuffer: TIdBytes;
  3324. {$ELSE}
  3325. var ABuffer: PChar;
  3326. {$ENDIF}
  3327. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3328. begin
  3329. IsNumberValid(APartNum);
  3330. Result := RetrievePart(AMsgNum, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3331. end;
  3332. function TIdIMAP4.RetrievePart(const AMsgNum: Integer; const APartNum: string;
  3333. {$IFDEF DOTNET}
  3334. var ABuffer: TIdBytes;
  3335. {$ELSE}
  3336. var ABuffer: PChar;
  3337. {$ENDIF}
  3338. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3339. //Retrieve a specific individual part of a message
  3340. begin
  3341. IsNumberValid(AMsgNum);
  3342. Result := InternalRetrievePart(AMsgNum, APartNum, False, False, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3343. end;
  3344. function TIdIMAP4.RetrievePartPeek(const AMsgNum: Integer; const APartNum: Integer;
  3345. {$IFDEF DOTNET}
  3346. var ABuffer: TIdBytes;
  3347. {$ELSE}
  3348. var ABuffer: PChar;
  3349. {$ENDIF}
  3350. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3351. begin
  3352. IsNumberValid(APartNum);
  3353. Result := RetrievePartPeek(AMsgNum, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3354. end;
  3355. function TIdIMAP4.RetrievePartPeek(const AMsgNum: Integer; const APartNum: string;
  3356. {$IFDEF DOTNET}
  3357. var ABuffer: TIdBytes;
  3358. {$ELSE}
  3359. var ABuffer: PChar;
  3360. {$ENDIF}
  3361. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3362. //Retrieve a specific individual part of a message
  3363. begin
  3364. IsNumberValid(AMsgNum);
  3365. Result := InternalRetrievePart(AMsgNum, APartNum, False, True, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3366. end;
  3367. function TIdIMAP4.UIDRetrievePart(const AMsgUID: String; const APartNum: Integer;
  3368. {$IFDEF DOTNET}
  3369. var ABuffer: TIdBytes;
  3370. {$ELSE}
  3371. var ABuffer: PChar;
  3372. {$ENDIF}
  3373. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3374. begin
  3375. IsNumberValid(APartNum);
  3376. Result := UIDRetrievePart(AMsgUID, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3377. end;
  3378. function TIdIMAP4.UIDRetrievePart(const AMsgUID: String; const APartNum: string;
  3379. {$IFDEF DOTNET}
  3380. var ABuffer: TIdBytes;
  3381. {$ELSE}
  3382. var ABuffer: PChar;
  3383. {$ENDIF}
  3384. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3385. //Retrieve a specific individual part of a message
  3386. begin
  3387. IsUIDValid(AMsgUID);
  3388. Result := InternalRetrievePart(StrToInt(AMsgUID), APartNum, True, False, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3389. end;
  3390. function TIdIMAP4.UIDRetrievePartPeek(const AMsgUID: String; const APartNum: Integer;
  3391. {$IFDEF DOTNET}
  3392. var ABuffer: TIdBytes;
  3393. {$ELSE}
  3394. var ABuffer: PChar;
  3395. {$ENDIF}
  3396. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3397. begin
  3398. IsNumberValid(APartNum);
  3399. Result := UIDRetrievePartPeek(AMsgUID, IntToStr(APartNum), ABuffer, ABufferLength, AContentTransferEncoding);
  3400. end;
  3401. function TIdIMAP4.UIDRetrievePartPeek(const AMsgUID: String; const APartNum: string;
  3402. {$IFDEF DOTNET}
  3403. var ABuffer: TIdBytes;
  3404. {$ELSE}
  3405. var ABuffer: PChar;
  3406. {$ENDIF}
  3407. var ABufferLength: Integer; AContentTransferEncoding: string): Boolean;
  3408. //Retrieve a specific individual part of a message
  3409. begin
  3410. IsUIDValid(AMsgUID);
  3411. Result := InternalRetrievePart(StrToInt(AMsgUID), APartNum, True, True, ABuffer, ABufferLength, '', AContentTransferEncoding); {Do not Localize}
  3412. end;
  3413. function TIdIMAP4.RetrievePartToFile(const AMsgNum: Integer; const APartNum: Integer;
  3414. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3415. begin
  3416. IsNumberValid(APartNum);
  3417. Result := RetrievePartToFile(AMsgNum, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3418. end;
  3419. function TIdIMAP4.RetrievePartToFile(const AMsgNum: Integer; const APartNum: string;
  3420. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3421. //Retrieve a specific individual part of a message
  3422. var
  3423. {$IFDEF DOTNET}
  3424. LDummy1: TIdBytes;
  3425. {$ELSE}
  3426. LDummy1: PChar;
  3427. {$ENDIF}
  3428. begin
  3429. IsNumberValid(AMsgNum);
  3430. if ADestFileNameAndPath = '' then begin {Do not Localize}
  3431. Result := False;
  3432. Exit;
  3433. end;
  3434. Result := InternalRetrievePart(AMsgNum, APartNum, False, False,
  3435. LDummy1, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3436. end;
  3437. function TIdIMAP4.RetrievePartToFilePeek(const AMsgNum: Integer; const APartNum: Integer;
  3438. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3439. begin
  3440. IsNumberValid(APartNum);
  3441. Result := RetrievePartToFilePeek(AMsgNum, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3442. end;
  3443. function TIdIMAP4.RetrievePartToFilePeek(const AMsgNum: Integer; const APartNum: string;
  3444. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3445. //Retrieve a specific individual part of a message
  3446. var
  3447. {$IFDEF DOTNET}
  3448. LDummy1: TIdBytes;
  3449. {$ELSE}
  3450. LDummy1: PChar;
  3451. {$ENDIF}
  3452. begin
  3453. IsNumberValid(AMsgNum);
  3454. if ADestFileNameAndPath = '' then begin {Do not Localize}
  3455. Result := False;
  3456. Exit;
  3457. end;
  3458. Result := InternalRetrievePart(AMsgNum, APartNum, False, True,
  3459. LDummy1, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3460. end;
  3461. function TIdIMAP4.UIDRetrievePartToFile(const AMsgUID: String; const APartNum: Integer;
  3462. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3463. begin
  3464. IsNumberValid(APartNum);
  3465. Result := UIDRetrievePartToFile(AMsgUID, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3466. end;
  3467. function TIdIMAP4.UIDRetrievePartToFile(const AMsgUID: String; const APartNum: string;
  3468. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3469. //Retrieve a specific individual part of a message
  3470. var
  3471. {$IFDEF DOTNET}
  3472. LDummy1: TIdBytes;
  3473. {$ELSE}
  3474. LDummy1: PChar;
  3475. {$ENDIF}
  3476. begin
  3477. IsUIDValid(AMsgUID);
  3478. if ADestFileNameAndPath = '' then begin {Do not Localize}
  3479. Result := False;
  3480. Exit;
  3481. end;
  3482. Result := InternalRetrievePart(StrToInt(AMsgUID), APartNum, True, False,
  3483. LDummy1, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3484. end;
  3485. function TIdIMAP4.UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: Integer;
  3486. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3487. begin
  3488. IsNumberValid(APartNum);
  3489. Result := UIDRetrievePartToFilePeek(AMsgUID, IntToStr(APartNum), ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3490. end;
  3491. function TIdIMAP4.UIDRetrievePartToFilePeek(const AMsgUID: String; const APartNum: {Integer} string;
  3492. ALength: Integer; ADestFileNameAndPath: string; AContentTransferEncoding: string): Boolean;
  3493. //Retrieve a specific individual part of a message
  3494. var
  3495. {$IFDEF DOTNET}
  3496. LDummy1: TIdBytes;
  3497. {$ELSE}
  3498. LDummy1: PChar;
  3499. {$ENDIF}
  3500. begin
  3501. IsUIDValid(AMsgUID);
  3502. if ADestFileNameAndPath = '' then begin {Do not Localize}
  3503. Result := False;
  3504. Exit;
  3505. end;
  3506. Result := InternalRetrievePart(StrToInt(AMsgUID), APartNum, True, True,
  3507. LDummy1, ALength, ADestFileNameAndPath, AContentTransferEncoding);
  3508. end;
  3509. function TIdIMAP4.InternalRetrievePart(const AMsgNum: Integer; const APartNum: {Integer} string;
  3510. AUseUID: Boolean; AUsePeek: Boolean;
  3511. {$IFDEF DOTNET}
  3512. var ABuffer: TIdBytes;
  3513. {$ELSE}
  3514. var ABuffer: PChar;
  3515. {$ENDIF}
  3516. var ABufferLength: Integer; {NOTE: var args cannot have default params}
  3517. ADestFileNameAndPath: string;
  3518. AContentTransferEncoding: string): Boolean;
  3519. //Retrieve a specific individual part of a message
  3520. var
  3521. LSlRetrieve : TIdStringList;
  3522. LCmd: string;
  3523. LSourceStream: TIdTCPStream;
  3524. LDestStream: TFileStream;
  3525. LIntermediateStream: TStringStream;
  3526. LBase64Decoder: TIdDecoderMIME;
  3527. LQuotedPrintableDecoder: TIdDecoderQuotedPrintable;
  3528. LBinHex4Decoder: TIdDecoderBinHex4;
  3529. LIdMemoryStream: TIdStreamVCL;
  3530. LIdDestStream: TIdStreamVCL;
  3531. LMemoryStream: TMemoryStream;
  3532. LBuffer: string;
  3533. LPartSizeParam: string;
  3534. //LStringForTesting: string;
  3535. LIdUnstrippedStream: TIdStreamVCL;
  3536. LIdIntermediateStream: TIdStreamVCL;
  3537. //LIdDestStream: TIdStream;
  3538. LN: integer;
  3539. {$IFDEF DOTNET}
  3540. //LIdUnstrippedStream: TIdStream;
  3541. //LIdIntermediateStream: TIdStream;
  3542. //LIdDestStream: TIdStream;
  3543. //LTBytesPtr: TBytes;
  3544. LTBytesPtr: TIdBytes;
  3545. {$ELSE}
  3546. LPtr: PChar;
  3547. {$ENDIF}
  3548. LStrippedStream: TStringStream;
  3549. LUnstrippedStream: TStringStream;
  3550. begin
  3551. {CCC: Make sure part number is valid since it is now passed as a string...}
  3552. IsImapPartNumberValid(APartNum);
  3553. {CC2: Default to returning False at this point...}
  3554. Result := False;
  3555. ABuffer := nil;
  3556. ABufferLength := 0;
  3557. if ( FConnectionState = csSelected ) then begin
  3558. LSlRetrieve := TIdStringList.Create;
  3559. try
  3560. LCmd := NewCmdCounter + ' '; {Do not Localize}
  3561. if AUseUID = True then begin
  3562. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  3563. end;
  3564. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + ' ('; {Do not Localize}
  3565. if AUsePeek = True then begin
  3566. LCmd := LCmd + IMAP4FetchDataItem[fdBody]+'.PEEK'; {Do not Localize}
  3567. end else begin
  3568. LCmd := LCmd + IMAP4FetchDataItem[fdBody];
  3569. end;
  3570. //LCmd := LCmd + '[' + IntToStr ( APartNum ) + '])'; {Do not Localize}
  3571. LCmd := LCmd + '[' + APartNum + '])'; {Do not Localize}
  3572. WriteLn(LCmd);
  3573. {CC7: wsBAD added because Ipswitch's IMAP server sometimes returns it here...}
  3574. //if ( GetLineResponse ( GetCmdCounter ) = IMAP_OK ) then begin
  3575. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True ) = IMAP_OK ) then begin
  3576. LPartSizeParam := ''; {Do not Localize}
  3577. if ( (ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], []) = False)
  3578. or (UpperCase(FLineStruct.IMAPValue) = 'NIL') or (UpperCase(FLineStruct.IMAPValue) = '""') or (FLineStruct.ByteCount < 1) ) then begin {do not localize}
  3579. GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False );
  3580. Result := False;
  3581. end else begin
  3582. {CC4: Some messages have an empty first part. These respond as:
  3583. 17 FETCH (BODY[1] "" UID 20)
  3584. instead of the more normal:
  3585. 17 FETCH (BODY[1] {11} {This bracket is not part of the response!
  3586. ...
  3587. UID 20)
  3588. }
  3589. ABufferLength := FLineStruct.ByteCount;
  3590. LSourceStream := TIdTCPStream.Create(Self);
  3591. if assigned(FOnWorkForPart) then begin
  3592. LSourceStream.Connection.OnWork := FOnWorkForPart;
  3593. end;
  3594. if assigned(FOnWorkBeginForPart) then begin
  3595. LSourceStream.Connection.OnWorkBegin := FOnWorkBeginForPart;
  3596. end;
  3597. if assigned(FOnWorkEndForPart) then begin
  3598. LSourceStream.Connection.OnWorkEnd := FOnWorkEndForPart;
  3599. end;
  3600. if ADestFileNameAndPath = '' then begin {Do not Localize}
  3601. {User wants to write it to a memory block...}
  3602. if TextIsSame(AContentTransferEncoding, 'base64') then begin {Do not Localize}
  3603. LMemoryStream := TMemoryStream.Create;
  3604. SetLength(LBuffer, ABufferLength);
  3605. LUnstrippedStream := TStringStream.Create('');
  3606. LIdUnstrippedStream := TIdStreamVCL.Create(LUnstrippedStream);
  3607. LSourceStream.Connection.IOHandler.ReadStream(LIdUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3608. {This is more complicated than quoted-printable because we
  3609. have to strip CRLFs that have been inserted by the MTA to
  3610. avoid overly long lines...}
  3611. LStrippedStream := TStringStream.Create('');
  3612. StripCRLFs(LUnstrippedStream, LStrippedStream);
  3613. LUnstrippedStream.Free;
  3614. LBase64Decoder := TIdDecoderMIME.Create(Self);
  3615. try
  3616. //LBase64Decoder.DecodeBegin(LMemoryStream);
  3617. LIdMemoryStream := TIdStreamVCL.Create(LMemoryStream);
  3618. LBase64Decoder.DecodeBegin(LIdMemoryStream);
  3619. {$IFDEF DOTNET}
  3620. LBuffer := Copy(LStrippedStream.DataString, 1, LStrippedStream.Size);
  3621. LBase64Decoder.Decode({LStrippedStream.DataString} LBuffer);
  3622. {$ELSE}
  3623. LBase64Decoder.Decode(LStrippedStream.DataString);
  3624. {$ENDIF}
  3625. LBase64Decoder.DecodeEnd;
  3626. finally
  3627. FreeAndNil(LBase64Decoder);
  3628. end;
  3629. LStrippedStream.Free;
  3630. ABufferLength := LMemoryStream.Size;
  3631. {$IFDEF DOTNET}
  3632. //ABuffer is a TIdBytes.
  3633. SetLength(ABuffer, ABufferLength);
  3634. LTBytesPtr := LMemoryStream.Memory;
  3635. for LN := 1 to ABufferLength do begin
  3636. ABuffer[LN-1] := {Byte(LBuffer[LN])} LTBytesPtr[LN-1];
  3637. end;
  3638. LMemoryStream.Free;
  3639. {$ELSE}
  3640. //ABuffer is a PChar.
  3641. GetMem(ABuffer, ABufferLength);
  3642. LPtr := LMemoryStream.Memory;
  3643. for LN := 0 to ABufferLength-1 do begin
  3644. ABuffer[LN] := LPtr^;
  3645. Inc(LPtr);
  3646. end;
  3647. LMemoryStream.Destroy;
  3648. {$ENDIF}
  3649. end else if TextIsSame(AContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  3650. LMemoryStream := TMemoryStream.Create;
  3651. SetLength(LBuffer, ABufferLength);
  3652. LUnstrippedStream := TStringStream.Create('');
  3653. LIdUnstrippedStream := TIdStreamVCL.Create(LUnstrippedStream);
  3654. LSourceStream.Connection.IOHandler.ReadStream(LIdUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3655. LQuotedPrintableDecoder := TIdDecoderQuotedPrintable.Create(Self);
  3656. try
  3657. //LQuotedPrintableDecoder.DecodeBegin(LMemoryStream);
  3658. LIdMemoryStream := TIdStreamVCL.Create(LMemoryStream);
  3659. LQuotedPrintableDecoder.DecodeBegin(LIdMemoryStream);
  3660. {$IFDEF DOTNET}
  3661. LBuffer := Copy(LUnstrippedStream.DataString, 1, LUnstrippedStream.Size);
  3662. LQuotedPrintableDecoder.Decode({LUnstrippedStream.DataString} LBuffer);
  3663. {$ELSE}
  3664. LQuotedPrintableDecoder.Decode(LUnstrippedStream.DataString);
  3665. {$ENDIF}
  3666. LQuotedPrintableDecoder.DecodeEnd;
  3667. finally
  3668. FreeAndNil(LQuotedPrintableDecoder);
  3669. end;
  3670. LUnstrippedStream.Free;
  3671. ABufferLength := LMemoryStream.Size;
  3672. {$IFDEF DOTNET}
  3673. SetLength(ABuffer, ABufferLength);
  3674. LTBytesPtr := LMemoryStream.Memory;
  3675. for LN := 1 to ABufferLength do begin
  3676. ABuffer[LN-1] := LTBytesPtr[LN-1];
  3677. end;
  3678. LMemoryStream.Free;
  3679. {$ELSE}
  3680. GetMem(ABuffer, ABufferLength);
  3681. LPtr := LMemoryStream.Memory;
  3682. for LN := 0 to ABufferLength-1 do begin
  3683. ABuffer[LN] := LPtr^;
  3684. Inc(LPtr);
  3685. end;
  3686. LMemoryStream.Destroy;
  3687. {$ENDIF}
  3688. end else if TextIsSame(AContentTransferEncoding, 'binhex40') then begin {Do not Localize}
  3689. LMemoryStream := TMemoryStream.Create;
  3690. SetLength(LBuffer, ABufferLength);
  3691. LUnstrippedStream := TStringStream.Create('');
  3692. LIdUnstrippedStream := TIdStreamVCL.Create(LUnstrippedStream);
  3693. LSourceStream.Connection.IOHandler.ReadStream(LIdUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3694. LBinHex4Decoder := TIdDecoderBinHex4.Create(Self);
  3695. try
  3696. //LBinHex4Decoder.DecodeBegin(LMemoryStream);
  3697. LIdMemoryStream := TIdStreamVCL.Create(LMemoryStream);
  3698. LBinHex4Decoder.DecodeBegin(LIdMemoryStream);
  3699. {$IFDEF DOTNET}
  3700. LBuffer := Copy(LUnstrippedStream.DataString, 1, LUnstrippedStream.Size);
  3701. LBinHex4Decoder.Decode({LUnstrippedStream.DataString} LBuffer);
  3702. {$ELSE}
  3703. LBinHex4Decoder.Decode(LUnstrippedStream.DataString);
  3704. {$ENDIF}
  3705. LBinHex4Decoder.DecodeEnd;
  3706. finally
  3707. FreeAndNil(LBinHex4Decoder);
  3708. end;
  3709. LUnstrippedStream.Free;
  3710. ABufferLength := LMemoryStream.Size;
  3711. {$IFDEF DOTNET}
  3712. SetLength(ABuffer, ABufferLength);
  3713. LTBytesPtr := LMemoryStream.Memory;
  3714. for LN := 1 to ABufferLength do begin
  3715. ABuffer[LN-1] := LTBytesPtr[LN-1];
  3716. end;
  3717. LMemoryStream.Free;
  3718. {$ELSE}
  3719. GetMem(ABuffer, ABufferLength);
  3720. LPtr := LMemoryStream.Memory;
  3721. for LN := 0 to ABufferLength-1 do begin
  3722. ABuffer[LN] := LPtr^;
  3723. Inc(LPtr);
  3724. end;
  3725. LMemoryStream.Destroy;
  3726. {$ENDIF}
  3727. end else begin
  3728. {Assume no encoding or something we cannot decode.}
  3729. //{Get a block of memory to read the part into...}
  3730. {$IFDEF DOTNET}
  3731. LUnstrippedStream := TStringStream.Create('');
  3732. LIdUnstrippedStream := TIdStreamVCL.Create(LUnstrippedStream);
  3733. LSourceStream.Connection.IOHandler.ReadStream(LIdUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3734. SetLength(ABuffer, ABufferLength);
  3735. LBuffer := Copy(LUnstrippedStream.DataString, 1, LUnstrippedStream.Size);
  3736. for LN := 1 to ABufferLength do begin
  3737. ABuffer[LN-1] := Byte(LBuffer[LN]);
  3738. end;
  3739. LUnstrippedStream.Free;
  3740. {$ELSE}
  3741. LUnstrippedStream := TStringStream.Create('');
  3742. LIdUnstrippedStream := TIdStreamVCL.Create(LUnstrippedStream);
  3743. LSourceStream.Connection.IOHandler.ReadStream(LIdUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3744. GetMem(ABuffer, ABufferLength);
  3745. LBuffer := LUnstrippedStream.DataString;
  3746. for LN := 1 to Length(LBuffer) do begin
  3747. ABuffer[LN-1] := LBuffer[LN];
  3748. end;
  3749. LUnstrippedStream.Free;
  3750. {$ENDIF}
  3751. end;
  3752. LSourceStream.Free;
  3753. end else begin
  3754. {User wants to write it to a file...}
  3755. LDestStream := TFileStream.Create(ADestFileNameAndPath, fmCreate);
  3756. if TextIsSame(AContentTransferEncoding, 'base64') then begin {Do not Localize}
  3757. {Strip out any embedded CRLFs which are inserted by MTAs to ensure
  3758. the line-length limit is not exceeded...}
  3759. SetLength(LBuffer, ABufferLength);
  3760. LUnstrippedStream := TStringStream.Create('');
  3761. LIdUnstrippedStream := TIdStreamVCL.Create(LUnstrippedStream);
  3762. LSourceStream.Connection.IOHandler.ReadStream(LIdUnstrippedStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3763. LStrippedStream := TStringStream.Create('');
  3764. StripCRLFs(LUnstrippedStream, LStrippedStream);
  3765. LUnstrippedStream.Free;
  3766. LBase64Decoder := TIdDecoderMIME.Create(nil);
  3767. try
  3768. //LBase64Decoder.DecodeBegin(LDestStream);
  3769. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  3770. LBase64Decoder.DecodeBegin(LIdDestStream);
  3771. {$IFDEF DOTNET}
  3772. LStrippedStream.Position := 0;
  3773. LBuffer := Copy(LStrippedStream.DataString, 1, LStrippedStream.Size);
  3774. LBase64Decoder.Decode(LBuffer);
  3775. {$ELSE}
  3776. LBase64Decoder.Decode(LStrippedStream.DataString);
  3777. {$ENDIF}
  3778. LBase64Decoder.DecodeEnd;
  3779. finally
  3780. FreeAndNil(LBase64Decoder);
  3781. end;
  3782. LStrippedStream.Free;
  3783. end else if TextIsSame(AContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  3784. LIntermediateStream := TStringStream.Create(''); {Do not Localize}
  3785. LIdIntermediateStream := TIdStreamVCL.Create(LIntermediateStream);
  3786. LSourceStream.Connection.IOHandler.ReadStream(LIdIntermediateStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3787. LQuotedPrintableDecoder := TIdDecoderQuotedPrintable.Create(nil);
  3788. try
  3789. //LQuotedPrintableDecoder.DecodeBegin(LDestStream);
  3790. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  3791. LQuotedPrintableDecoder.DecodeBegin(LIdDestStream);
  3792. {$IFDEF DOTNET}
  3793. LBuffer := Copy(LIntermediateStream.DataString, 1, LIntermediateStream.Size);
  3794. LQuotedPrintableDecoder.Decode({LIntermediateStream.DataString} LBuffer);
  3795. {$ELSE}
  3796. LQuotedPrintableDecoder.Decode(LIntermediateStream.DataString);
  3797. {$ENDIF}
  3798. LQuotedPrintableDecoder.DecodeEnd;
  3799. finally
  3800. FreeAndNil(LQuotedPrintableDecoder);
  3801. end;
  3802. LIntermediateStream.Free;
  3803. end else if TextIsSame(AContentTransferEncoding, 'binhex40') then begin {Do not Localize}
  3804. LIntermediateStream := TStringStream.Create(''); {Do not Localize}
  3805. LIdIntermediateStream := TIdStreamVCL.Create(LIntermediateStream);
  3806. LSourceStream.Connection.IOHandler.ReadStream(LIdIntermediateStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3807. LBinHex4Decoder := TIdDecoderBinHex4.Create(Self);
  3808. try
  3809. //LBinHex4Decoder.DecodeBegin(LDestStream);
  3810. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  3811. LBinHex4Decoder.DecodeBegin(LIdDestStream);
  3812. {$IFDEF DOTNET}
  3813. LBuffer := Copy(LIntermediateStream.DataString, 1, LIntermediateStream.Size);
  3814. LBinHex4Decoder.Decode({LIntermediateStream.DataString} LBuffer);
  3815. {$ELSE}
  3816. LBinHex4Decoder.Decode(LIntermediateStream.DataString);
  3817. {$ENDIF}
  3818. LBinHex4Decoder.DecodeEnd;
  3819. finally
  3820. FreeAndNil(LBinHex4Decoder);
  3821. end;
  3822. LIntermediateStream.Free;
  3823. end else begin
  3824. {Assume no encoding or something we cannot decode...}
  3825. //Recode the following to use a TIdStreamVCL...
  3826. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  3827. LSourceStream.Connection.IOHandler.ReadStream(LIdDestStream, ABufferLength); //ReadStream uses OnWork, most other methods dont
  3828. end;
  3829. LSourceStream.Free;
  3830. LDestStream.Free;
  3831. end;
  3832. ReadLnWait(); {Remove last line, ')' or 'UID 1)'}
  3833. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False ) = IMAP_OK then begin
  3834. {Only return TRUE if get to here...}
  3835. Result := True;
  3836. end;
  3837. end;
  3838. end;
  3839. finally
  3840. LSlRetrieve.Free;
  3841. end;
  3842. end else begin
  3843. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3844. end;
  3845. end;
  3846. function TIdIMAP4.UIDRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  3847. begin
  3848. IsUIDValid(AMsgUID);
  3849. Result := UIDInternalRetrieveStructure(AMsgUID, AMsg, nil);
  3850. end;
  3851. function TIdIMAP4.UIDRetrieveStructure(const AMsgUID: String; AParts: TIdImapMessageParts): Boolean;
  3852. begin
  3853. IsUIDValid(AMsgUID);
  3854. Result := UIDInternalRetrieveStructure(AMsgUID, nil, AParts);
  3855. end;
  3856. function TIdIMAP4.UIDInternalRetrieveStructure(const AMsgUID: String; AMsg: TIdMessage; AParts: TIdImapMessageParts): Boolean;
  3857. label
  3858. UnexpectedResponse;
  3859. var
  3860. LSlRetrieve : TIdStringList;
  3861. LStr: string;
  3862. LPartsList: TIdStringList;
  3863. LTheParts: TIdMessageParts;
  3864. begin
  3865. {CC2: Default to returning False at this point...}
  3866. Result := False;
  3867. LPartsList := TIdStringList.Create;
  3868. if ( FConnectionState = csSelected ) then begin
  3869. LSlRetrieve := TIdStringList.Create;
  3870. try
  3871. WriteLn ( NewCmdCounter + ' ' + ( IMAP4Commands[cmdUID] + ' ' + {Do not Localize}
  3872. IMAP4Commands[cmdFetch] + ' ' + AMsgUID + ' (' + {Do not Localize}
  3873. IMAP4FetchDataItem[fdBodyStructure] + ')' ) ); {Do not Localize}
  3874. //Note: The normal single-line response may be split for huge bodystructures,
  3875. //allow for this by setting ASingleLineMayBeSplit to True...
  3876. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True, True ) = IMAP_OK ) then begin
  3877. if LastCmdResult.Text.Count > 0 then begin
  3878. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  3879. end;
  3880. if ( (LSlRetrieve.Count > 2) and
  3881. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  3882. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdBodyStructure])) ) then begin {Do not Localize}
  3883. LStr := Copy ( LastCmdResult.Text[0],
  3884. Pos ( IMAP4FetchDataItem[fdBodyStructure] + ' (', {Do not Localize}
  3885. LastCmdResult.Text[0] ) + {Do not Localize}
  3886. Length ( IMAP4FetchDataItem[fdBodyStructure] + ' (' ), {Do not Localize}
  3887. MaxInt );
  3888. LStr := Copy ( LStr, 1, Pos( ') '+IMAP4Commands[cmdUID]+' '+AMsgUID+')', LStr ) - 1); {Do not Localize}
  3889. end else if ( (LSlRetrieve.Count > 2) and
  3890. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  3891. (TextIsSame(LSlRetrieve[2], '(' + IMAP4Commands[cmdUID])) ) then begin {Do not Localize}
  3892. LStr := Copy ( LastCmdResult.Text[0],
  3893. Pos ( IMAP4FetchDataItem[fdBodyStructure] + ' (', {Do not Localize}
  3894. LastCmdResult.Text[0] ) + {Do not Localize}
  3895. Length ( IMAP4FetchDataItem[fdBodyStructure] + ' (' ), {Do not Localize}
  3896. MaxInt );
  3897. LStr := Copy ( LStr, 1, Length ( LStr ) - 2); {Do not Localize}
  3898. end else begin
  3899. goto UnexpectedResponse;
  3900. end;
  3901. if AMsg <> nil then begin
  3902. LTheParts := AMsg.MessageParts;
  3903. ParseBodyStructureResult(LStr, LTheParts, nil);
  3904. end;
  3905. if AParts <> nil then begin
  3906. ParseBodyStructureResult(LStr, nil, AParts);
  3907. end;
  3908. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False ) = IMAP_OK then begin
  3909. {Only return TRUE if get to here...}
  3910. Result := True;
  3911. end;
  3912. UnexpectedResponse:
  3913. end;
  3914. finally
  3915. LSlRetrieve.Free;
  3916. end;
  3917. end else begin
  3918. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3919. end;
  3920. LPartsList.Free;
  3921. end;
  3922. function TIdIMAP4.RetrieveHeader(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  3923. var LSlRetrieve : TIdStringList;
  3924. begin
  3925. IsNumberValid(AMsgNum);
  3926. {CC2: Default to returning False at this point...}
  3927. Result := False;
  3928. if ( FConnectionState = csSelected ) then begin
  3929. LSlRetrieve := TIdStringList.Create;
  3930. try
  3931. WriteLn ( NewCmdCounter + ' ' + ( {Do not Localize}
  3932. IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + ' (' + {Do not Localize}
  3933. IMAP4FetchDataItem[fdRFC822Header] + ')' ) ); {Do not Localize}
  3934. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch]], True ) = IMAP_OK ) then begin
  3935. if LastCmdResult.Text.Count > 0 then begin
  3936. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  3937. end;
  3938. {CC: Make sure we have enough words}
  3939. if ( (LSlRetrieve.Count > 2) and
  3940. (TextIsSame(LSlRetrieve[0], IntToStr( AMsgNum ))) and
  3941. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  3942. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdRFC822Header])) ) then begin {Do not Localize}
  3943. {CC2: Clear out body so don't get multiple copies of bodies}
  3944. AMsg.Headers.Clear;
  3945. ReceiveHeader ( AMsg, ')' ); {Do not Localize}
  3946. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch]], False ) = IMAP_OK then begin
  3947. {CC2: Only return TRUE if get to here...}
  3948. Result := True;
  3949. end;
  3950. end;
  3951. end;
  3952. finally
  3953. LSlRetrieve.Free;
  3954. end;
  3955. end else begin
  3956. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  3957. end;
  3958. end;
  3959. function TIdIMAP4.UIDRetrieveHeader(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  3960. label
  3961. UnexpectedResponse;
  3962. var
  3963. LSlRetrieve : TIdStringList;
  3964. LExpectedResponse: string;
  3965. begin
  3966. IsUIDValid(AMsgUID);
  3967. {CC2: Default to returning False at this point...}
  3968. Result := False;
  3969. if ( FConnectionState = csSelected ) then begin
  3970. LSlRetrieve := TIdStringList.Create;
  3971. try
  3972. WriteLn ( NewCmdCounter + ' ' + ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + {Do not Localize}
  3973. AMsgUID + ' (' + IMAP4FetchDataItem[fdRFC822Header] + ')' ) ); {Do not Localize}
  3974. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True ) = IMAP_OK ) then begin
  3975. if LastCmdResult.Text.Count > 0 then begin
  3976. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  3977. end;
  3978. {CC: Make sure we have enough words}
  3979. {CC: Format of response is 1 FETCH (RFC812.HEADER {953} {, this is decoding incorrectly}
  3980. {CC5: or else 1 FETCH (UID 123 RFC812.HEADER {953} {, this is decoding incorrectly}
  3981. if ( (LSlRetrieve.Count > 2) and
  3982. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  3983. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdRFC822Header])) ) then begin {Do not Localize}
  3984. LExpectedResponse := ' '+IMAP4Commands[cmdUID]+' '+AMsgUID+')'; {Do not Localize}
  3985. end else if ( (LSlRetrieve.Count > 2) and
  3986. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  3987. (TextIsSame(LSlRetrieve[2], '(' + IMAP4Commands[cmdUID])) ) then begin {Do not Localize}
  3988. LExpectedResponse := ')'; {Do not Localize}
  3989. end else begin
  3990. goto UnexpectedResponse;
  3991. end;
  3992. {CC2: Trap the correct UID response}
  3993. {CC2: Clear out body so don't get multiple copies of bodies}
  3994. AMsg.Headers.Clear;
  3995. ReceiveHeader ( AMsg, LExpectedResponse ); {Do not Localize}
  3996. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False ) = IMAP_OK then begin
  3997. {CC2: Only return TRUE if get to here...}
  3998. Result := True;
  3999. end;
  4000. UnexpectedResponse:
  4001. end;
  4002. finally
  4003. LSlRetrieve.Free;
  4004. end;
  4005. end else begin
  4006. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4007. end;
  4008. end;
  4009. function TIdIMAP4.RetrievePartHeader(const AMsgNum: Integer; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  4010. begin
  4011. IsNumberValid(AMsgNum);
  4012. Result := InternalRetrievePartHeader(AMsgNum, APartNum, False, AHeaders);
  4013. end;
  4014. function TIdIMAP4.UIDRetrievePartHeader(const AMsgUID: String; const APartNum: string; AHeaders: TIdHeaderList): Boolean;
  4015. begin
  4016. IsUIDValid(AMsgUID);
  4017. Result := InternalRetrievePartHeader(StrToInt(AMsgUID), APartNum, True, AHeaders);
  4018. end;
  4019. function TIdIMAP4.InternalRetrievePartHeader(const AMsgNum: Integer; const APartNum: string;
  4020. const AUseUID: Boolean; AHeaders: TIdHeaderList): Boolean;
  4021. label
  4022. UnexpectedResponse;
  4023. var
  4024. LCmd: string;
  4025. LSlRetrieve : TIdStringList;
  4026. LExpectedResponse: string;
  4027. LPartSizeParam: string;
  4028. LMessageLength: integer;
  4029. LSourceStream: TIdTCPStream;
  4030. LDestStream: TStringStream;
  4031. LIdDestStream: TIdStreamVCL;
  4032. begin
  4033. {CC2: Default to returning False at this point...}
  4034. Result := False;
  4035. if ( FConnectionState = csSelected ) then begin
  4036. LSlRetrieve := TIdStringList.Create;
  4037. try
  4038. LCmd := NewCmdCounter + ' '; {Do not Localize}
  4039. if AUseUID = True then begin
  4040. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  4041. end;
  4042. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + {Do not Localize}
  4043. IntToStr ( AMsgNum ) + ' (' + IMAP4FetchDataItem[fdBody] + {Do not Localize}
  4044. '[' + APartNum + '.' + IMAP4FetchDataItem[fdHeader] + ']' + {Do not Localize}
  4045. ')'; {Do not Localize}
  4046. WriteLn ( LCmd ); {Do not Localize}
  4047. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True ) = IMAP_OK ) then begin
  4048. if LastCmdResult.Text.Count > 0 then begin
  4049. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  4050. end;
  4051. {Format of response is 1 FETCH (BODY[2.1.HEADER] {953} {
  4052. { or else 1 FETCH (UID 123 BODY[2.1.HEADER] {953}
  4053. if (
  4054. (LSlRetrieve.Count > 2) and
  4055. (TextIsSame( LSlRetrieve[1], IMAP4Commands[cmdFetch] )) and
  4056. (TextIsSame( LSlRetrieve[2], '('+IMAP4FetchDataItem[fdBody]+'['+APartNum+'.'+IMAP4FetchDataItem[fdHeader]+']' )) {Do not Localize}
  4057. ) then begin
  4058. LExpectedResponse := ' '+IMAP4Commands[cmdUID]+' '+IntToStr(AMsgNum)+')'; {Do not Localize}
  4059. LPartSizeParam := LSlRetrieve[LSlRetrieve.Count-1];
  4060. end else if ( (LSlRetrieve.Count > 2) and
  4061. (TextIsSame( LSlRetrieve[1], IMAP4Commands[cmdFetch] )) and
  4062. (TextIsSame( LSlRetrieve[2], '(' + IMAP4Commands[cmdUID] )) ) then begin {Do not Localize}
  4063. LExpectedResponse := ')'; {Do not Localize}
  4064. LPartSizeParam := LSlRetrieve[LSlRetrieve.Count-1];
  4065. end else begin
  4066. goto UnexpectedResponse;
  4067. end;
  4068. if LPartSizeParam <> '' then begin {Paranoia, should not happen} {Do not Localize}
  4069. {For an invalid request (non-existent part or message), NIL
  4070. can be returned as the size...}
  4071. if ((UpperCase(LPartSizeParam) <> 'NIL)') and (UpperCase(LPartSizeParam) <> 'NIL') and (UpperCase(LPartSizeParam) <> '{NIL}')) then begin {Do not Localize}
  4072. {CC4: Some messages have an empty first part. These respond as:
  4073. 17 FETCH (BODY[1] "" UID 20)
  4074. instead of the more normal:
  4075. 17 FETCH (BODY[1] {11} {This bracket is not part of the response!
  4076. ...
  4077. UID 20)
  4078. }
  4079. if LPartSizeParam <> '""' then begin {Do not Localize}
  4080. LMessageLength := StrToInt(Copy(LPartSizeParam, 2, Length(LPartSizeParam)-2));
  4081. LSourceStream := TIdTCPStream.Create(Self);
  4082. LDestStream := TStringStream.Create('');
  4083. //TODO: Recode the following to use a TIdStreamVCL...
  4084. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  4085. LSourceStream.Connection.IOHandler.ReadStream(LIdDestStream, LMessageLength); //ReadStream uses OnWork, most other methods dont
  4086. {$IFDEF DOTNET}
  4087. AHeaders.Text := Copy(LDestStream.DataString, 1, LDestStream.Size);
  4088. {$ELSE}
  4089. AHeaders.Text := TStringStream(LIdDestStream.VCLStream).DataString;
  4090. {$ENDIF}
  4091. LSourceStream.Free;
  4092. LDestStream.Free;
  4093. LIdDestStream.Free;
  4094. end;
  4095. end;
  4096. end;
  4097. ReadLnWait;
  4098. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False ) = IMAP_OK then begin
  4099. {CC2: Only return TRUE if get to here...}
  4100. Result := True;
  4101. end;
  4102. UnexpectedResponse:
  4103. end;
  4104. finally
  4105. LSlRetrieve.Free;
  4106. end;
  4107. end else begin
  4108. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4109. end;
  4110. end;
  4111. function TIdIMAP4.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
  4112. //This code was just pulled up from IdMessageClient so that logging could be added.
  4113. begin
  4114. // BeginWork(wmRead);
  4115. // try
  4116. repeat
  4117. Result := IOHandler.ReadLn;
  4118. // Exchange Bug: Exchange sometimes returns . when getting a message instead of
  4119. // '' then a . - That is there is no seperation between the header and the message for an
  4120. // empty message.
  4121. if ((Length(AAltTerm) = 0) and (Result = '.')) or
  4122. ({APR: why? (Length(AAltTerm) > 0) and }(Result = AAltTerm)) then begin
  4123. Break;
  4124. end else if Result <> '' then begin
  4125. AMsg.Headers.Append(Result);
  4126. end;
  4127. until False;
  4128. AMsg.ProcessHeaders;
  4129. // finally
  4130. // EndWork(wmRead);
  4131. // end;
  4132. end;
  4133. {CC8: UIDREtrieveAllHeaders removed, makes no sense to implement this.}
  4134. {function TIdIMAP4.UIDRetrieveAllHeaders(AMsgList: TIdMessageCollection): Boolean;}
  4135. {CC5: This is not, and never was, implemented: why would you use it?}
  4136. {begin}
  4137. { Result := False;
  4138. end;}
  4139. function TIdIMAP4.Retrieve(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  4140. begin
  4141. IsNumberValid(AMsgNum);
  4142. Result := InternalRetrieve(AMsgNum, False, False, False, AMsg);
  4143. end;
  4144. function TIdIMAP4.RetrieveNoDecodeToFile (const AMsgNum: Integer; ADestFile: string): Boolean;
  4145. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4146. var
  4147. LMsg: TIdMessage;
  4148. begin
  4149. Result := False;
  4150. IsNumberValid(AMsgNum);
  4151. LMsg := TIdMessage.Create(nil);
  4152. if InternalRetrieve(AMsgNum, False, False, True, LMsg) then begin
  4153. LMsg.NoEncode := True;
  4154. LMsg.SaveToFile(ADestFile);
  4155. Result := True;
  4156. end;
  4157. LMsg.Destroy;
  4158. end;
  4159. function TIdIMAP4.RetrieveNoDecodeToStream (const AMsgNum: Integer; AStream: TStream): Boolean;
  4160. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4161. var
  4162. LMsg: TIdMessage;
  4163. begin
  4164. Result := False;
  4165. IsNumberValid(AMsgNum);
  4166. LMsg := TIdMessage.Create(nil);
  4167. if InternalRetrieve(AMsgNum, False, False, True, LMsg) then begin
  4168. LMsg.NoEncode := True;
  4169. LMsg.SaveToStream(AStream);
  4170. Result := True;
  4171. end;
  4172. LMsg.Destroy;
  4173. end;
  4174. function TIdIMAP4.RetrievePeek(const AMsgNum: Integer; AMsg: TIdMessage): Boolean;
  4175. begin
  4176. IsNumberValid(AMsgNum);
  4177. Result := InternalRetrieve(AMsgNum, False, True, False, AMsg);
  4178. end;
  4179. function TIdIMAP4.UIDRetrieve(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  4180. begin
  4181. IsUIDValid(AMsgUID);
  4182. Result := InternalRetrieve(StrToInt(AMsgUID), True, False, False, AMsg);
  4183. end;
  4184. function TIdIMAP4.UIDRetrieveNoDecodeToFile (const AMsgUID: String; ADestFile: string): Boolean;
  4185. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4186. var
  4187. LMsg: TIdMessage;
  4188. begin
  4189. Result := False;
  4190. IsUIDValid(AMsgUID);
  4191. LMsg := TIdMessage.Create(nil);
  4192. if InternalRetrieve(StrToInt(AMsgUID), True, False, True, LMsg) then begin
  4193. LMsg.NoEncode := True;
  4194. LMsg.SaveToFile(ADestFile);
  4195. Result := True;
  4196. end;
  4197. LMsg.Destroy;
  4198. end;
  4199. function TIdIMAP4.UIDRetrieveNoDecodeToStream (const AMsgUID: String; AStream: TStream): Boolean;
  4200. //Retrieves a whole message "raw" and saves it to file, while marking it read.
  4201. var
  4202. LMsg: TIdMessage;
  4203. begin
  4204. Result := False;
  4205. IsUIDValid(AMsgUID);
  4206. LMsg := TIdMessage.Create(nil);
  4207. if InternalRetrieve(StrToInt(AMsgUID), True, False, True, LMsg) then begin
  4208. LMsg.NoEncode := True;
  4209. LMsg.SaveToStream(AStream);
  4210. Result := True;
  4211. end;
  4212. LMsg.Destroy;
  4213. end;
  4214. function TIdIMAP4.UIDRetrievePeek(const AMsgUID: String; AMsg: TIdMessage): Boolean;
  4215. begin
  4216. IsUIDValid(AMsgUID);
  4217. Result := InternalRetrieve(StrToInt(AMsgUID), True, True, False, AMsg);
  4218. end;
  4219. function TIdIMAP4.InternalRetrieve(const AMsgNum: Integer; AUseUID: Boolean; AUsePeek: Boolean; ANoDecode: Boolean; AMsg: TIdMessage): Boolean;
  4220. var LSlRetrieve : TIdStringList;
  4221. LStr: String;
  4222. LCmd: string;
  4223. //LMessageLength: integer;
  4224. LTempPathname: string;
  4225. //LMessageTerminator: string;
  4226. LSourceStream: TIdTCPStream;
  4227. LDestStream: TFileStream;
  4228. LIdDestStream: TIdStreamVCL;
  4229. begin
  4230. {Default to returning False at this point...}
  4231. Result := False;
  4232. if ( FConnectionState = csSelected ) then begin
  4233. LSlRetrieve := TIdStringList.Create;
  4234. try
  4235. LCmd := NewCmdCounter + ' '; {Do not Localize}
  4236. if AUseUID = True then begin
  4237. LCmd := LCmd + IMAP4Commands[cmdUID] + ' '; {Do not Localize}
  4238. end;
  4239. LCmd := LCmd + IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + ' ('; {Do not Localize}
  4240. if AUsePeek = True then begin
  4241. LCmd := LCmd + IMAP4FetchDataItem[fdBodyPeek]; {Do not Localize}
  4242. end else begin
  4243. LCmd := LCmd + IMAP4FetchDataItem[fdRFC822]; {Do not Localize}
  4244. end;
  4245. LCmd := LCmd + ')'; {Do not Localize}
  4246. WriteLn(LCmd);
  4247. //if ( GetLineResponse ( GetCmdCounter ) = IMAP_OK ) then begin
  4248. if ( GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], True ) = IMAP_OK ) then begin
  4249. //Leave 3rd param as [] because ParseLastCmdResult can get a number of odd
  4250. //replies ( variants on Body[] )...
  4251. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], []) = False then begin
  4252. Exit;
  4253. end;
  4254. {CC8: Retrieve via byte count instead of looking for terminator,
  4255. which was impossible to get working with all the different IMAP
  4256. servers because some left the terminator (LExpectedResponse) at
  4257. the end of a message line, so you could not decide if it was
  4258. part of the message or the terminator.}
  4259. AMsg.Headers.Clear; {Clear out headers so don't get multiple copies of headers}
  4260. AMsg.Body.Clear; {Clear out body so don't get multiple copies of bodies}
  4261. AMsg.MessageParts.Clear; {Clear out parts so don't get multiple copies of parts}
  4262. //if LPartSizeParam <> '' then begin {Paranoia, should not happen} {Do not Localize}
  4263. if FLineStruct.ByteCount > 0 then begin
  4264. {For an invalid request (non-existent part or message), NIL
  4265. can be returned as the size...}
  4266. //if ((UpperCase(LPartSizeParam) <> 'NIL)') and (UpperCase(LPartSizeParam) <> 'NIL') and (UpperCase(LPartSizeParam) <> '{NIL}')) then begin {Do not Localize}
  4267. {CC4: Some messages have an empty first part. These respond as:
  4268. 17 FETCH (BODY[1] "" UID 20)
  4269. instead of the more normal:
  4270. 17 FETCH (BODY[1] {11} {This bracket is not part of the response!
  4271. ...
  4272. UID 20)
  4273. }
  4274. //if LPartSizeParam <> '""' then begin {Do not Localize}
  4275. // LMessageLength := StrToInt(Copy(LPartSizeParam, 2, Length(LPartSizeParam)-2));
  4276. {Use a temporary file to suck the message into...}
  4277. LSourceStream := TIdTCPStream.Create(Self);
  4278. if assigned(FOnWorkForPart) then begin
  4279. LSourceStream.Connection.OnWork := FOnWorkForPart;
  4280. end;
  4281. if assigned(FOnWorkBeginForPart) then begin
  4282. LSourceStream.Connection.OnWorkBegin := FOnWorkBeginForPart;
  4283. end;
  4284. if assigned(FOnWorkEndForPart) then begin
  4285. LSourceStream.Connection.OnWorkEnd := FOnWorkEndForPart;
  4286. end;
  4287. LTempPathname := MakeTempFilename;
  4288. LDestStream := TFileStream.Create(LTempPathname, fmCreate);
  4289. {Assume no encoding or something we cannot decode...}
  4290. //LDestStream.CopyFrom(LSourceStream, LMessageLength);
  4291. //TODO #DONE#: Recode to use a TIdStreamVCL...
  4292. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  4293. LSourceStream.Connection.IOHandler.ReadStream(LIdDestStream, FLineStruct.ByteCount); //ReadStream uses OnWork, most other methods dont
  4294. LSourceStream.Free;
  4295. LDestStream.Free;
  4296. if ANoDecode then begin
  4297. AMsg.NoDecode := True;
  4298. end;
  4299. {Feed LTempPathname into the standard message parser...}
  4300. AMsg.LoadFromFile(LTempPathname);
  4301. {Delete LTempPathname...}
  4302. DeleteFile(LTempPathname);
  4303. //end;
  4304. //end;
  4305. end;
  4306. LStr := ReadLnWait; {Remove trailing line after the message, probably a ')' }
  4307. ParseLastCmdResultButAppendInfo(LStr); //There may be a UID or FLAGS in this
  4308. if GetInternalResponse ( GetCmdCounter, [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]], False ) = IMAP_OK then begin
  4309. {CC2: Only return TRUE if get to here...}
  4310. Result := True;
  4311. end else begin
  4312. Exit;
  4313. end;
  4314. AMsg.UID := FLineStruct.UID;
  4315. AMsg.Flags := FLineStruct.Flags;
  4316. end;
  4317. finally
  4318. LSlRetrieve.Free;
  4319. end;
  4320. end else begin
  4321. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4322. end;
  4323. end;
  4324. function TIdIMAP4.RetrieveAllHeaders(AMsgList: TIdMessageCollection): Boolean;
  4325. var
  4326. LMsgItem : TIdMessageItem;
  4327. Ln : Integer;
  4328. begin
  4329. {CC2: This may get a response of "OK completed" if there are no messages}
  4330. if ( FConnectionState = csSelected ) then begin
  4331. if ( AMsgList <> nil ) then begin
  4332. Result := True;
  4333. for Ln := 1 to FMailBox.TotalMsgs do begin
  4334. LMsgItem := AMsgList.Add;
  4335. if not RetrieveHeader ( Ln, LMsgItem.Msg ) then begin
  4336. Result := False;
  4337. Break;
  4338. end;
  4339. end;
  4340. end else begin
  4341. Result := False;
  4342. end;
  4343. end else begin
  4344. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4345. Result := False;
  4346. end;
  4347. end;
  4348. function TIdIMAP4.RetrieveAllMsgs(AMsgList: TIdMessageCollection): Boolean;
  4349. var LMsgItem : TIdMessageItem;
  4350. Ln : Integer;
  4351. begin
  4352. {CC2: This may get a response of "OK completed" if there are no messages}
  4353. if ( FConnectionState = csSelected ) then begin
  4354. if ( AMsgList <> nil ) then begin
  4355. Result := True;
  4356. for Ln := 1 to FMailBox.TotalMsgs do begin
  4357. LMsgItem := AMsgList.Add;
  4358. if not Retrieve ( Ln, LMsgItem.Msg ) then begin
  4359. Result := False;
  4360. Break;
  4361. end;
  4362. end;
  4363. end else begin
  4364. Result := False;
  4365. end;
  4366. end else begin
  4367. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4368. Result := False;
  4369. end;
  4370. end;
  4371. function TIdIMAP4.DeleteMsgs(const AMsgNumList: array of Integer): Boolean;
  4372. begin
  4373. Result := StoreFlags (AMsgNumList, sdAdd, [mfDeleted]);
  4374. end;
  4375. function TIdIMAP4.UIDDeleteMsg(const AMsgUID: String): Boolean;
  4376. begin
  4377. IsUIDValid(AMsgUID);
  4378. Result := UIDStoreFlags (AMsgUID, sdAdd, [mfDeleted]);
  4379. end;
  4380. function TIdIMAP4.UIDDeleteMsgs(const AMsgUIDList: array of String): Boolean;
  4381. begin
  4382. Result := UIDStoreFlags (AMsgUIDList, sdAdd, [mfDeleted]);
  4383. end;
  4384. function TIdIMAP4.RetrieveMailBoxSize: Integer;
  4385. var LSlRetrieve : TIdStringList;
  4386. Ln : Integer;
  4387. begin
  4388. if ( FConnectionState = csSelected ) then begin
  4389. {CC2: This should not be checking FMailBox.TotalMsgs because the server may
  4390. have added messages to the mailbox unknown to us, and we are going to ask the
  4391. server anyway (if it's empty, we will return 0 anyway}
  4392. {CC5: Remove dependancy on FMailBox.TotalMsgs}
  4393. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdFetch] + ' 1:*' + {Do not Localize}
  4394. ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')' ), [IMAP4Commands[cmdFetch]] ); {Do not Localize}
  4395. if LastCmdResult.Code = IMAP_OK then begin
  4396. Result := 0;
  4397. LSlRetrieve := TIdStringList.Create;
  4398. try
  4399. for Ln := 0 to ( FMailBox.TotalMsgs - 1 )do begin
  4400. BreakApart ( LastCmdResult.Text[Ln], ' ', LSlRetrieve ); {Do not Localize}
  4401. {CC: Make sure we have enough words}
  4402. {CC2: Change LSlRetrieve.Count > 2 to 3 since we use LSlRetrieve[3] later}
  4403. if ( (LSlRetrieve.Count > 3) and
  4404. (TextIsSame(LSlRetrieve[0], IntToStr( Ln + 1 ))) and
  4405. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4406. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdRFC822Size])) ) then begin {Do not Localize}
  4407. Result := Result + StrToInt (Copy ( LSlRetrieve[3], 1, ( Length ( LSlRetrieve[3] ) - 1 ) ) );
  4408. end else begin
  4409. {CC2: Return -1, not 0, if we cannot parse the result...}
  4410. Result := -1;
  4411. Break;
  4412. end;
  4413. LSlRetrieve.Clear;
  4414. end;
  4415. finally
  4416. LSlRetrieve.Free;
  4417. end;
  4418. end else begin
  4419. Result := -1;
  4420. end;
  4421. end else begin
  4422. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4423. Result := -1;
  4424. end;
  4425. end;
  4426. function TIdIMAP4.UIDRetrieveMailBoxSize: Integer;
  4427. var LSlRetrieve : TIdStringList;
  4428. Ln : Integer;
  4429. LTemp: string;
  4430. begin
  4431. if ( FConnectionState = csSelected ) then begin
  4432. {CC2: This should not be checking FMailBox.TotalMsgs because the server may
  4433. have added messages to the mailbox unknown to us, and we are going to ask the
  4434. server anyway (if it's empty, we will return 0 anyway}
  4435. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' 1:*' + {Do not Localize}
  4436. ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')' ), [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]] ); {Do not Localize}
  4437. if LastCmdResult.Code = IMAP_OK then begin
  4438. Result := 0;
  4439. LSlRetrieve := TIdStringList.Create;
  4440. try
  4441. for Ln := 0 to ( FMailBox.TotalMsgs - 1 )do begin
  4442. BreakApart ( LastCmdResult.Text[Ln], ' ', LSlRetrieve ); {Do not Localize}
  4443. {CC: Make sure we have enough words}
  4444. {CC2: Change LSlRetrieve.Count > 4 to 5 since we use LSlRetrieve[5] later}
  4445. {CC2: Correct the parsing of the return value, add begin/end as per guidelines}
  4446. if ( (LSlRetrieve.Count > 5) and
  4447. (TextIsSame(LSlRetrieve[0], IntToStr( Ln + 1 ))) and
  4448. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4449. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdRFC822Size])) ) then begin {Do not Localize}
  4450. {CC5: Change parsing, watch out for possible trailing bracket...}
  4451. LTemp := Copy ( LSlRetrieve[3], 1, MaxInt );
  4452. if LTemp[Length(LTemp)] = ')' then begin {Do not Localize}
  4453. LTemp := Copy(LTemp, 1, Length(LTemp)-1);
  4454. end;
  4455. Result := Result + StrToInt ( LTemp );
  4456. end else if ( (LSlRetrieve.Count > 5) and
  4457. (TextIsSame(LSlRetrieve[0], IntToStr( Ln + 1 ))) and
  4458. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4459. (TextIsSame(LSlRetrieve[4], IMAP4FetchDataItem[fdRFC822Size])) ) then begin {Do not Localize}
  4460. {CC5: Change parsing, watch out for possible trailing bracket...}
  4461. LTemp := Copy ( LSlRetrieve[5], 1, MaxInt );
  4462. if LTemp[Length(LTemp)] = ')' then begin {Do not Localize}
  4463. LTemp := Copy(LTemp, 1, Length(LTemp)-1);
  4464. end;
  4465. Result := Result + StrToInt ( LTemp );
  4466. end else begin
  4467. {Result := 0;}
  4468. {CC2: Return -1, not 0, if we cannot parse the result...}
  4469. Result := -1;
  4470. Break;
  4471. end;
  4472. LSlRetrieve.Clear;
  4473. end;
  4474. finally
  4475. LSlRetrieve.Free;
  4476. end;
  4477. end else begin
  4478. Result := -1;
  4479. end;
  4480. end else begin
  4481. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4482. Result := -1;
  4483. end;
  4484. end;
  4485. function TIdIMAP4.RetrieveMsgSize(const AMsgNum: Integer): Integer;
  4486. var LSlRetrieve : TIdStringList;
  4487. begin
  4488. IsNumberValid(AMsgNum);
  4489. if ( FConnectionState = csSelected ) then begin
  4490. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + {Do not Localize}
  4491. ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')' ), [IMAP4Commands[cmdFetch]] ); {Do not Localize}
  4492. if LastCmdResult.Code = IMAP_OK then begin
  4493. LSlRetrieve := TIdStringList.Create;
  4494. try
  4495. if LastCmdResult.Text.Count > 0 then begin
  4496. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  4497. end;
  4498. {CC: Make sure we have enough words}
  4499. {CC2: Change LSlRetrieve.Count > 2 to 3 since we use LSlRetrieve[3] later}
  4500. if ( (LSlRetrieve.Count > 3) and
  4501. (TextIsSame(LSlRetrieve[0], IntToStr( AMsgNum ))) and
  4502. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4503. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdRFC822Size])) ) then begin {Do not Localize}
  4504. Result := StrToInt (Copy ( LSlRetrieve[3], 1, ( Length ( LSlRetrieve[3] ) - 1 ) ) );
  4505. end else begin
  4506. Result := -1;
  4507. end;
  4508. finally
  4509. LSlRetrieve.Free;
  4510. end;
  4511. end else begin
  4512. Result := -1;
  4513. end;
  4514. end else begin
  4515. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4516. Result := -1;
  4517. end;
  4518. end;
  4519. function TIdIMAP4.UIDRetrieveMsgSize(const AMsgUID: String): Integer;
  4520. var LSlRetrieve : TIdStringList;
  4521. begin
  4522. IsUIDValid(AMsgUID);
  4523. if ( FConnectionState = csSelected ) then
  4524. begin
  4525. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + {Do not Localize}
  4526. ' ' + AMsgUID + ' (' + IMAP4FetchDataItem[fdRFC822Size] + ')' ), [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]] ); {Do not Localize}
  4527. if LastCmdResult.Code = IMAP_OK then begin
  4528. LSlRetrieve := TIdStringList.Create;
  4529. try
  4530. if LastCmdResult.Text.Count > 0 then begin
  4531. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  4532. end;
  4533. {CC: Make sure we have enough words}
  4534. {CC2: Change LSlRetrieve.Count > 4 to 5 since we use LSlRetrieve[5] later}
  4535. {CC2: sort out the response properly}
  4536. if ( (LSlRetrieve.Count > 5) and
  4537. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4538. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdRfc822Size])) ) then begin {Do not Localize}
  4539. Result := StrToInt (Copy (LSlRetrieve[3], 1, MaxInt));
  4540. end else if ( (LSlRetrieve.Count > 5) and
  4541. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4542. (TextIsSame(LSlRetrieve[2], '(' + IMAP4Commands[cmdUID])) ) then begin {Do not Localize}
  4543. Result := StrToInt (Copy (LSlRetrieve[5], 1, Length(LSlRetrieve[5])-1));
  4544. end else begin
  4545. Result := -1;
  4546. end;
  4547. finally
  4548. LSlRetrieve.Free;
  4549. end;
  4550. end else begin
  4551. Result := -1;
  4552. end;
  4553. end else begin
  4554. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4555. Result := -1;
  4556. end;
  4557. end;
  4558. function TIdIMAP4.CheckMsgSeen(const AMsgNum: Integer): Boolean;
  4559. var
  4560. Ln : Integer;
  4561. LSlRetrieve : TIdStringList;
  4562. begin
  4563. IsNumberValid(AMsgNum);
  4564. Result := False;
  4565. if (FConnectionState = csSelected) then begin
  4566. SendCmd(NewCmdCounter, (IMAP4Commands[cmdFetch] + ' ' + IntToStr(AMsgNum) + {Do not Localize}
  4567. ' (' + IMAP4FetchDataItem[fdFlags] + ')' ), [IMAP4Commands[cmdFetch]] ); {Do not Localize}
  4568. if LastCmdResult.Code = IMAP_OK then begin
  4569. for Ln := 0 to (LastCmdResult.Text.Count - 1) do begin
  4570. LSlRetrieve := TIdStringList.Create;
  4571. try
  4572. // DS 13-Mar-2001 Fix Bug # 494813
  4573. BreakApart(LastCmdResult.Text[Ln], ' ', LSlRetrieve); {Do not Localize}
  4574. {CC: Make sure we have enough words}
  4575. if ( (LSlRetrieve.Count > 2) and
  4576. (TextIsSame(LSlRetrieve[0], IntToStr(AMsgNum))) and
  4577. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4578. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdFlags])) ) then begin {Do not Localize}
  4579. Result := (Pos(MessageFlags[mfSeen], LastCmdResult.Text[Ln]) > 0);
  4580. end;
  4581. finally
  4582. LSlRetrieve.Free;
  4583. end;
  4584. end;
  4585. end else begin
  4586. Result := False;
  4587. end;
  4588. end else begin
  4589. raise EIdConnectionStateError.CreateFmt(RSIMAP4ConnectionStateError, [GetConnectionStateName]);
  4590. Result := False;
  4591. end;
  4592. end;
  4593. function TIdIMAP4.UIDCheckMsgSeen(const AMsgUID: String): Boolean;
  4594. var LSlRetrieve : TIdStringList;
  4595. begin
  4596. IsUIDValid(AMsgUID);
  4597. {Default to unseen, so if get no flags back (i.e. no \Seen flag)
  4598. we return False (i.e. we return it is unseen)
  4599. Some servers return nothing at all if no flags set (the better ones return an empty set).}
  4600. Result := False;
  4601. if ( FConnectionState = csSelected ) then begin
  4602. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + {Do not Localize}
  4603. AMsgUID + ' (' + IMAP4FetchDataItem[fdFlags] + ')' ), [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]] ); {Do not Localize}
  4604. if LastCmdResult.Code = IMAP_OK then begin
  4605. LSlRetrieve := TIdStringList.Create;
  4606. try
  4607. if LastCmdResult.Text.Count > 0 then begin {CCB: Trap no response from some servers if no flags}
  4608. BreakApart ( LastCmdResult.Text[0], ' ', LSlRetrieve ); {Do not Localize}
  4609. end;
  4610. {CC: Check LSlRetrieve.Count > 4 (otherwise, last line (which only has a count of 1) gives a "List index out of bounds" error)
  4611. {CC: Testing against LSlRetrieve[3] and LSlRetrieve[4] does not work if multiple flags returned (if you really wanted to sort it, they would be LSlRetrieve[LS1Retrieve.Count-X])}
  4612. {CC: LSlRetrieve[2] should be '(' + IMAP4FetchDataItem[fdFlags], not '(' + IMAP4FetchDataItem[fdUID]}
  4613. if ( (LSlRetrieve.Count > 4) and
  4614. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4615. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdFlags])) ) then begin {Do not Localize}
  4616. if ( Pos ( MessageFlags[mfSeen], LastCmdResult.Text[0] ) > 0 ) then begin
  4617. Result := True;
  4618. end;
  4619. end;
  4620. finally
  4621. LSlRetrieve.Free;
  4622. end;
  4623. end else begin
  4624. Result := False;
  4625. end;
  4626. end else begin
  4627. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4628. Result := False;
  4629. end;
  4630. end;
  4631. {CC: use "var" to get results returned}
  4632. function TIdIMAP4.RetrieveFlags(const AMsgNum: Integer; var AFlags: {Pointer}TIdMessageFlagsSet): Boolean;
  4633. var Ln: Integer;
  4634. LStr: String;
  4635. LSlRetrieve: TIdStringList;
  4636. begin
  4637. IsNumberValid(AMsgNum);
  4638. Result := False;
  4639. {CC: Empty set to avoid returning resuts from a previous call if call fails}
  4640. AFlags := [];
  4641. if ( FConnectionState = csSelected ) then begin
  4642. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdFetch] + ' ' + IntToStr ( AMsgNum ) + {Do not Localize}
  4643. ' (' + IMAP4FetchDataItem[fdFlags] + ')' ), [IMAP4Commands[cmdFetch]] ); {Do not Localize}
  4644. if LastCmdResult.Code = IMAP_OK then begin
  4645. for Ln := 0 to ( LastCmdResult.Text.Count - 1 ) do begin
  4646. LSlRetrieve := TIdStringList.Create;
  4647. try
  4648. {CC: Loop on [Ln] (was [0]) }
  4649. BreakApart ( LastCmdResult.Text[Ln], ' ', LSlRetrieve ); {Do not Localize}
  4650. {CC: Make sure we have enough params - if we requested a non-existent message number,
  4651. server may return nothing except the OK response}
  4652. if ( (LSlRetrieve.Count > 2) and
  4653. (TextIsSame(LSlRetrieve[0], IntToStr(AMsgNum))) and
  4654. (TextIsSame(LSlRetrieve[1], IMAP4Commands[cmdFetch])) and
  4655. (TextIsSame(LSlRetrieve[2], '(' + IMAP4FetchDataItem[fdFlags])) ) then begin {Do not Localize}
  4656. LStr := Copy ( LastCmdResult.Text[Ln],
  4657. ( Pos ( IMAP4FetchDataItem[fdFlags] + ' (', LastCmdResult.Text[Ln] ) + {Do not Localize}
  4658. Length ( IMAP4FetchDataItem[fdFlags] + ' (' ) ), {Do not Localize}
  4659. Length ( LastCmdResult.Text[Ln] ) );
  4660. LStr := Copy ( LStr, 1, ( Pos ( '))', LStr ) - 1 ) ); {Do not Localize}
  4661. ParseMessageFlagString ( LStr, AFlags );
  4662. Result := True;
  4663. end;
  4664. finally
  4665. LSlRetrieve.Free;
  4666. end;
  4667. end;
  4668. end else begin
  4669. Result := False;
  4670. end;
  4671. end else begin
  4672. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4673. Result := False;
  4674. end;
  4675. end;
  4676. {CC: use "var" to get results returned}
  4677. function TIdIMAP4.UIDRetrieveFlags(const AMsgUID: String; var AFlags: TIdMessageFlagsSet): Boolean;
  4678. begin
  4679. IsUIDValid(AMsgUID);
  4680. Result := False;
  4681. {BUG FIX: Empty set to avoid returning resuts from a previous call if call fails}
  4682. AFlags := [];
  4683. if ( FConnectionState = csSelected ) then begin
  4684. SendCmd ( NewCmdCounter, ( IMAP4Commands[cmdUID] + ' ' + IMAP4Commands[cmdFetch] + ' ' + {Do not Localize}
  4685. AMsgUID + ' (' + IMAP4FetchDataItem[fdFlags] + ')' ), [IMAP4Commands[cmdFetch], IMAP4Commands[cmdUID]] ); {Do not Localize}
  4686. if LastCmdResult.Code = IMAP_OK then begin
  4687. //Might as well leave 3rd param as [] because ParseLastCmdResult always grabs the flags...
  4688. if ParseLastCmdResult(LastCmdResult.Text[0], IMAP4Commands[cmdFetch], []) = True then begin
  4689. AFlags := FLineStruct.Flags;
  4690. Result := True;
  4691. end;
  4692. end else begin
  4693. Result := False;
  4694. end;
  4695. end else begin
  4696. raise EIdConnectionStateError.CreateFmt (RSIMAP4ConnectionStateError, [GetConnectionStateName] );
  4697. Result := False;
  4698. end;
  4699. end;
  4700. function TIdIMAP4.GetConnectionStateName: String;
  4701. begin
  4702. case FConnectionState of
  4703. csAny : Result := RSIMAP4ConnectionStateAny;
  4704. csNonAuthenticated : Result := RSIMAP4ConnectionStateNonAuthenticated;
  4705. csAuthenticated : Result := RSIMAP4ConnectionStateAuthenticated;
  4706. csSelected : Result := RSIMAP4ConnectionStateSelected;
  4707. end;
  4708. end;
  4709. { ...TIdIMAP4 Commands }
  4710. { Parser Functions... }
  4711. procedure TIdIMAP4.ParseImapPart(ABodyStructure: string;
  4712. AImapParts: TIdImapMessageParts; AThisImapPart: TIdImapMessagePart; AParentImapPart: TIdImapMessagePart; //ImapPart version
  4713. APartNumber: integer);
  4714. {This recursively parses down. It gets either a line like:
  4715. "text" "plain" ("charset" "ISO-8859-1") NIL NIL "7bit" 40 1 NIL NIL NIL
  4716. which it parses into AThisImapPart, and we are done (at the end of the recursive calls), or a line like:
  4717. ("text" "plain"...NIL)("text" "html"...NIL) "alternative" ("boundary" "----bdry") NIL NIL
  4718. when we need to add "alternative" and the boundary to this part, but recurse down for the 1st two parts.}
  4719. var
  4720. LNextImapPart: TIdImapMessagePart;
  4721. LSubParts: TIdStringList;
  4722. LPartNumber: integer;
  4723. begin
  4724. Trim(ABodyStructure);
  4725. AThisImapPart.FUnparsedEntry := ABodyStructure;
  4726. if ABodyStructure[1] <> '(' then begin {Do not Localize}
  4727. //We are at the bottom. Parse the low-level '"text" "plain"...' into this part.
  4728. ParseBodyStructurePart(ABodyStructure, nil, AThisImapPart);
  4729. if AParentImapPart = nil then begin
  4730. //This is the top-level part, and it is "text" "plain" etc, so it is not MIME...
  4731. AThisImapPart.Encoding := mePlainText;
  4732. AThisImapPart.ImapPartNumber := '1'; {Do not Localize}
  4733. AThisImapPart.ParentPart := -1;
  4734. end else begin
  4735. AThisImapPart.Encoding := meMIME;
  4736. AThisImapPart.ImapPartNumber := AParentImapPart.ImapPartNumber+'.'+IntToStr(APartNumber); {Do not Localize}
  4737. //If we are the first level down in MIME, the parent part was '', so trim...
  4738. if AThisImapPart.ImapPartNumber[1] = '.' then begin {Do not Localize}
  4739. AThisImapPart.ImapPartNumber := Copy(AThisImapPart.ImapPartNumber, 2, MAXINT);
  4740. end;
  4741. AThisImapPart.ParentPart := AParentImapPart.Index;
  4742. end;
  4743. end else begin
  4744. AThisImapPart.Encoding := meMIME;
  4745. if AParentImapPart = nil then begin
  4746. AThisImapPart.ImapPartNumber := '';
  4747. AThisImapPart.ParentPart := -1;
  4748. end else begin
  4749. AThisImapPart.ImapPartNumber := AParentImapPart.ImapPartNumber+'.'+IntToStr(APartNumber); {Do not Localize}
  4750. //If we are the first level down in MIME, the parent part was '', so trim...
  4751. if AThisImapPart.ImapPartNumber[1] = '.' then begin {Do not Localize}
  4752. AThisImapPart.ImapPartNumber := Copy(AThisImapPart.ImapPartNumber, 2, MAXINT);
  4753. end;
  4754. AThisImapPart.ParentPart := AParentImapPart.Index;
  4755. end;
  4756. LSubParts := TIdStringList.Create;
  4757. ParseIntoBrackettedQuotedAndUnquotedParts(ABodyStructure, LSubParts, True);
  4758. LPartNumber := 1;
  4759. while LSubParts[0][1] = '(' do begin {Do not Localize}
  4760. LNextImapPart := AImapParts.Add;
  4761. ParseImapPart(Copy(LSubParts[0], 2, Length(LSubParts[0])-2), AImapParts, LNextImapPart, AThisImapPart, LPartNumber);
  4762. LSubParts.Delete(0);
  4763. Inc(LPartNumber);
  4764. end;
  4765. //LSubParts now (only) holds the params for this part...
  4766. AThisImapPart.FBodyType := LowerCase(GetNextQuotedParam(LSubParts[0], True)); //mixed, alternative
  4767. end;
  4768. end;
  4769. procedure TIdIMAP4.ParseMessagePart(ABodyStructure: string;
  4770. AMessageParts: TIdMessageParts; AThisMessagePart: TIdMessagePart; AParentMessagePart: TIdMessagePart; //MessageParts version
  4771. APartNumber: integer);
  4772. {WARNING: Not used by writer, may have bugs.
  4773. Version of ParseImapPart except using TIdMessageParts. Added for compatibility with
  4774. TIdMessage.MessageParts, but does not have enough functionality for many IMAP functions.}
  4775. var
  4776. LNextMessagePart: TIdMessagePart;
  4777. LSubParts: TIdStringList;
  4778. LPartNumber: integer;
  4779. begin
  4780. Trim(ABodyStructure);
  4781. if ABodyStructure[1] <> '(' then begin {Do not Localize}
  4782. //We are at the bottom. Parse this into this part.
  4783. ParseBodyStructurePart(ABodyStructure, AThisMessagePart, nil);
  4784. if AParentMessagePart = nil then begin
  4785. //This is the top-level part, and it is "text" "plain" etc, so it is not MIME...
  4786. AThisMessagePart.ParentPart := -1;
  4787. end else begin
  4788. AThisMessagePart.ParentPart := AParentMessagePart.Index;
  4789. end;
  4790. end else begin
  4791. LSubParts := TIdStringList.Create;
  4792. ParseIntoBrackettedQuotedAndUnquotedParts(ABodyStructure, LSubParts, True);
  4793. LPartNumber := 1;
  4794. while LSubParts[0][1] = '(' do begin {Do not Localize}
  4795. LNextMessagePart :=
  4796. TIdAttachmentMemory.Create(AMessageParts);
  4797. ParseMessagePart(Copy(LSubParts[0], 2, Length(LSubParts[0])-2), AMessageParts, LNextMessagePart, AThisMessagePart, LPartNumber);
  4798. LSubParts.Delete(0);
  4799. Inc(LPartNumber);
  4800. end;
  4801. //LSubParts now (only) holds the params for this part...
  4802. if AParentMessagePart = nil then begin
  4803. AThisMessagePart.ParentPart := -1;
  4804. end else begin
  4805. AThisMessagePart.ParentPart := AParentMessagePart.Index;
  4806. end;
  4807. end;
  4808. end;
  4809. procedure TIdIMAP4.ParseBodyStructureResult(ABodyStructure: string; ATheParts: TIdMessageParts;
  4810. AImapParts: TIdImapMessageParts);
  4811. {CC2: Function added to support individual part retreival}
  4812. begin
  4813. {
  4814. If it's a single-part message, it won't be enclosed in brackets - it will be:
  4815. "body type": "TEXT", "application", "image", "MESSAGE" (followed by subtype RFC822 for envelopes, ignore)
  4816. "body subtype": "PLAIN", "octet-stream", "tiff", "html"
  4817. "body parameter parenthesized list": bracketted list of pairs ("CHARSET" "US-ASCII" "NAME" "cc.tif" "format" "flowed"), ("charset" "ISO-8859-1")
  4818. "body id": NIL, 986767766767887@fg.com
  4819. "body description": NIL, "Compiler diff"
  4820. "body encoding": "7bit" "8bit" "binary" (NO encoding used with these), "quoted-printable" "base64" "ietf-token" "x-token"
  4821. "body size" 2279
  4822. "body lines" 48 (only present for some types, only those with "body type=text" and "body subtype=plain" that I found, if not present it WONT be a NIL, it just won't be there! However, it won't be needed)
  4823. <don't know> NIL
  4824. <don't know> ("inline" ("filename" "classbd.h")), ("attachment" ("filename" "DEGDAY.WB3"))
  4825. <don't know> NIL
  4826. Example:
  4827. * 4 FETCH (BODYSTRUCTURE ("text" "plain" ("charset" "ISO-8859-1") NIL NIL "7bit" 40 1 NIL NIL NIL))
  4828. ---------------------------------------------------------------------------
  4829. For most multi-part messages, each part will be bracketted:
  4830. ( (part 1 stuff) (part 2 stuff) "mixed" (boundary) NIL NIL )
  4831. Example:
  4832. * 1 FETCH (BODYSTRUCTURE (("text" "plain" ("charset" "us-ascii" "format" "flowed")
  4833. NIL NIL "7bit" 52 3 NIL NIL NIL)("text" "plain" ("name" "tnkin.txt") NIL NIL
  4834. "7bit" 28421 203 NIL ("inline" ("filename" "tnkin.txt")) NIL) "mixed"
  4835. ("boundary" "------------070105030104060407030601") NIL NIL))
  4836. ---------------------------------------------------------------------------
  4837. Some multiparts are bracketted again. This is the "alternative" encoding,
  4838. part 1 has two parts, a plain-text part and a html part:
  4839. ( ( (part 1a stuff) (part 1b stuff) "alternative" (boundary) NIL NIL ) (part 2 stuff) "mixed" (boundary) NIL NIL )
  4840. 1 2 2 1
  4841. Example:
  4842. * 50 FETCH (BODYSTRUCTURE ((("text" "plain" ("charset" "ISO-8859-1") NIL NIL
  4843. "quoted-printable" 415 12 NIL NIL NIL)("text" "html" ("charset" "ISO-8859-1")
  4844. NIL NIL "quoted-printable" 1034 25 NIL NIL NIL) "alternative" ("boundary"
  4845. "----=_NextPart_001_0027_01C33A37.33CFE220") NIL NIL)("application" "x-zip-compressed"
  4846. ("name" "IdIMAP4.zip") NIL NIL "base64" 20572 NIL ("attachment" ("filename"
  4847. "IdIMAP4.zip")) NIL) "mixed" ("boundary" "----=_NextPart_000_0026_01C33A37.33CFE220")
  4848. NIL NIL) UID 62)
  4849. }
  4850. {CC7: New code uses a different parsing method that allows for multisection parts.}
  4851. //Trim(ABodyStructure);
  4852. if AImapParts <> nil then begin //Just sort out the ImapParts version for now
  4853. ParseImapPart(ABodyStructure, AImapParts, AImapParts.Add, nil, -1);
  4854. end;
  4855. if ATheParts <> nil then begin
  4856. ParseMessagePart(ABodyStructure, ATheParts,
  4857. TIdAttachmentMemory.Create(ATheParts),
  4858. nil, -1);
  4859. end;
  4860. end;
  4861. procedure TIdIMAP4.ParseTheLine(ALine: string; APartsList: TIdStringList);
  4862. var
  4863. LTempList: TIdStringList;
  4864. LN: integer;
  4865. LStr, LWord: string;
  4866. begin
  4867. {Parse it and see what we get...}
  4868. LTempList := TIdStringList.Create;
  4869. ParseIntoParts(ALine, LTempList);
  4870. {Copy any parts from LTempList into the list of parts LPartsList...}
  4871. for LN := 0 to LTempList.Count-1 do begin
  4872. LStr := LTempList.Strings[LN];
  4873. LWord := LowerCase(GetNextWord(LStr));
  4874. if ((LStr[1] = '(') or (LWord = '"text"') or (LWord = '"image"') or (LWord = '"application"')) then begin {Do not Localize}
  4875. APartsList.Add(LStr);
  4876. end;
  4877. end;
  4878. end;
  4879. procedure TIdIMAP4.ParseBodyStructurePart(APartString: string; AThePart: TIdMessagePart;
  4880. AImapPart: TIdImapMessagePart{; AImapSubSection: TIdImapSubSection});
  4881. {CC3: Function added to support individual part retreival}
  4882. var
  4883. LParams: TIdStringList;
  4884. LContentDispositionStuff: string;
  4885. LFilename: string;
  4886. LDescription: string;
  4887. LTemp: string;
  4888. LSize: integer;
  4889. begin
  4890. {Individual parameters may be strings like "text", NIL, a number, or bracketted pairs like
  4891. ("CHARSET" "US-ASCII" "NAME" "cc.tif" "format" "flowed")...}
  4892. {There are three common line formats, with differing numbers of parameters:
  4893. (a) "TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 2879 69 NIL NIL NIL
  4894. (a) "TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 2879 69 NIL NIL
  4895. (c) "TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 2879 69
  4896. Note the last one only has 7 parameters, need to watch we don't index past the 7th!}
  4897. LParams := TIdStringList.Create;
  4898. ParseIntoParts(APartString, LParams);
  4899. {Build up strings into same format as used by message decoders...}
  4900. {Content Disposition: If present, may be at index 8 or 9...}
  4901. {CC8: Altered to allow for case where it may not be present at all (get "List
  4902. index out of bounds" error if try to access non-existent LParams[9])...}
  4903. LContentDispositionStuff := ''; {Do not Localize}
  4904. if LParams.Count > 9 then begin {Have an LParams[9]}
  4905. if LParams[9] = 'NIL' then begin {Do not Localize}
  4906. {It's NIL at 9, must be at 8...}
  4907. if LParams[8] = 'NIL' then begin {Do not Localize}
  4908. LContentDispositionStuff := LParams[8];
  4909. end;
  4910. end else begin
  4911. {It's not NIL, must be valid...}
  4912. LContentDispositionStuff := LParams[9];
  4913. end;
  4914. end else if LParams.Count > 8 then begin {Have an LParams[8]}
  4915. if LParams[8] = 'NIL' then begin {Do not Localize}
  4916. LContentDispositionStuff := LParams[8];
  4917. end;
  4918. end;
  4919. {Find and clean up the filename, if present...}
  4920. LFilename := ''; {Do not Localize}
  4921. if IndyPos('"NAME"', UpperCase(APartString)) > 0 then begin {Do not Localize}
  4922. LTemp := Copy(APartString, IndyPos('"NAME" ', UpperCase(APartString))+7, MaxInt); {Do not Localize}
  4923. LFilename := GetNextQuotedParam(LTemp, False);
  4924. end else if IndyPos('"FILENAME"', UpperCase(APartString)) > 0 then begin {Do not Localize}
  4925. LTemp := Copy(APartString, IndyPos('"FILENAME" ', UpperCase(APartString))+11, MaxInt); {Do not Localize}
  4926. LFilename := GetNextQuotedParam(LTemp, False);
  4927. end;
  4928. {If the filename starts and ends with double-quotes, remove them...}
  4929. if Length(LFilename) > 1 then begin
  4930. if ( (LFilename[1] = '"') and (LFilename[Length(LFilename)] = '"') ) then begin {Do not Localize}
  4931. LFilename := Copy(LFilename, 2, Length(LFilename)-2);
  4932. end;
  4933. end;
  4934. {CC7: The filename may be encoded, so decode it...}
  4935. if Length(LFilename) > 1 then begin
  4936. LFilename := DecodeHeader(LFilename);
  4937. end;
  4938. LSize := 0;
  4939. if ((LParams[6] <> 'NIL') and (LParams[6] <> '')) then LSize := StrToInt(LParams[6]); {Do not Localize}
  4940. LDescription := ''; {Do not Localize}
  4941. if ((LParams.Count > 9) and (LParams[9] <> 'NIL')) then begin {Do not Localize}
  4942. LDescription := GetNextQuotedParam(LParams[9], False);
  4943. end else if ((LParams.Count > 8) and (LParams[8] <> 'NIL')) then begin {Do not Localize}
  4944. LDescription := GetNextQuotedParam(LParams[8], False);
  4945. end;
  4946. if AThePart <> nil then begin
  4947. {Put into the same format as TIdMessage MessageParts...}
  4948. AThePart.ContentType := LParams[0]+'/'+LParams[1]+ParseBodyStructureSectionAsEquates(LParams[2]); {Do not Localize}
  4949. AThePart.ContentTransfer := LParams[5];
  4950. //Watch out for BinHex4.0, the encoding is inferred from the Content-Type...
  4951. if TextIsSame(Copy(AThePart.ContentType, 1, 24), 'application/mac-binhex40') then begin {do not localize}
  4952. AThePart.ContentTransfer := 'binhex40'; {do not localize}
  4953. end;
  4954. AThePart.DisplayName := LFilename;
  4955. end;
  4956. if AImapPart <> nil then begin
  4957. AImapPart.FBodyType := LParams[0];
  4958. AImapPart.FBodySubType := LParams[1];
  4959. AImapPart.FFileName := LFilename;
  4960. AImapPart.FDescription := LDescription;
  4961. AImapPart.FContentTransferEncoding := LParams[5];
  4962. AImapPart.FSize := LSize;
  4963. //Watch out for BinHex4.0, the encoding is inferred from the Content-Type...
  4964. if ( (TextIsSame(AImapPart.FBodyType, 'application')) {do not localize}
  4965. and (TextIsSame(AImapPart.FBodySubType, 'mac-binhex40')) ) then begin {do not localize}
  4966. AImapPart.FContentTransferEncoding := 'binhex40'; {do not localize}
  4967. end;
  4968. end;
  4969. LParams.Free;
  4970. end;
  4971. procedure TIdIMAP4.ParseIntoParts(APartString: string; AParams: TIdStringList);
  4972. var
  4973. LInPart: Integer;
  4974. LStartPos: Integer;
  4975. LParam: string;
  4976. LBracketLevel: Integer;
  4977. Ln: Integer;
  4978. LInQuotesInsideBrackets: Boolean;
  4979. begin
  4980. LStartPos := 0; {Stop compiler whining}
  4981. LBracketLevel := 0; {Stop compiler whining}
  4982. LInQuotesInsideBrackets := False; {Stop compiler whining}
  4983. LInPart := 0; {0 is not in a part, 1 is in a quote-delimited part, 2 is in a bracketted parameter-pair list}
  4984. for Ln := 1 to Length(APartString) do begin
  4985. if LInPart = 1 then begin
  4986. if APartString[Ln] = '"' then begin {Do not Localize}
  4987. LParam := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  4988. AParams.Add(LParam);
  4989. LInPart := 0;
  4990. end;
  4991. end else if LInPart = 2 then begin
  4992. //We have to watch out that we don't close this entry on a closing bracket within
  4993. //quotes, like ("Blah" "Blah)Blah"), so monitor if we are in quotes within brackets.
  4994. if APartString[Ln] = '"' then begin {Do not Localize}
  4995. LInQuotesInsideBrackets := not LInQuotesInsideBrackets;
  4996. end else begin
  4997. //Brackets don't count if they are within quoted strings...
  4998. if LInQuotesInsideBrackets = False then begin
  4999. if APartString[Ln] = '(' then begin {Do not Localize}
  5000. Inc(LBracketLevel);
  5001. end else if APartString[Ln] = ')' then begin {Do not Localize}
  5002. Dec(LBracketLevel);
  5003. if LBracketLevel = 0 then begin
  5004. LParam := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5005. AParams.Add(LParam);
  5006. LInPart := 0;
  5007. end;
  5008. end;
  5009. end;
  5010. end;
  5011. end else if LInPart = 3 then begin
  5012. if APartString[Ln] = 'L' then begin {Do not Localize}
  5013. LParam := Copy(APartString, LStartPos, Ln-LStartPos+1);
  5014. AParams.Add(LParam);
  5015. LInPart := 0;
  5016. end;
  5017. end else if LInPart = 4 then begin
  5018. if ((Ord(APartString[Ln]) < Ord('0')) or (Ord(APartString[Ln]) > Ord('9'))) then begin {Do not Localize}
  5019. LParam := Copy(APartString, LStartPos, Ln-LStartPos);
  5020. AParams.Add(LParam);
  5021. LInPart := 0;
  5022. end;
  5023. end else if APartString[Ln] = '"' then begin {Do not Localize}
  5024. {Start of a quoted param like "text"}
  5025. LStartPos := Ln;
  5026. LInPart := 1;
  5027. end else if APartString[Ln] = '(' then begin {Do not Localize}
  5028. {Start of a set of paired parameter/value strings within brackets,
  5029. such as ("charset" "us-ascii"). Note these can be nested (bracket pairs
  5030. within bracket pairs) }
  5031. LStartPos := Ln;
  5032. LInPart := 2;
  5033. LBracketLevel := 1;
  5034. LInQuotesInsideBrackets := False;
  5035. end else if APartString[Ln] = 'N' then begin {Do not Localize}
  5036. {Start of a NIL entry}
  5037. LStartPos := Ln;
  5038. LInPart := 3;
  5039. end else if ((Ord(APartString[Ln]) >= Ord('0')) and (Ord(APartString[Ln]) <= Ord('9'))) then begin {Do not Localize}
  5040. {Start of a numeric entry like 12345}
  5041. LStartPos := Ln;
  5042. LInPart := 4;
  5043. end;
  5044. end;
  5045. {We could be in a numeric entry when we hit the end of the line...}
  5046. if LInPart = 4 then begin
  5047. LParam := Copy(APartString, LStartPos, MaxInt);
  5048. AParams.Add(LParam);
  5049. end;
  5050. end;
  5051. procedure TIdIMAP4.ParseIntoBrackettedQuotedAndUnquotedParts(APartString: string; AParams: TIdStringList; AKeepBrackets: Boolean);
  5052. var
  5053. LInPart: Integer;
  5054. LStartPos: Integer;
  5055. LParam: string;
  5056. LBracketLevel: Integer;
  5057. Ln: Integer;
  5058. LInQuotesInsideBrackets: Boolean;
  5059. begin
  5060. {Break:
  5061. * LIST (\UnMarked \AnotherFlag) "/" "Mailbox name"
  5062. into:
  5063. *
  5064. LIST
  5065. (\UnMarked \AnotherFlag)
  5066. "/"
  5067. "Mailbox name"
  5068. If AKeepBrackets is false, return '\UnMarked \AnotherFlag' instead of '(\UnMarked \AnotherFlag)'
  5069. }
  5070. AParams.Clear;
  5071. LStartPos := 0; {Stop compiler whining}
  5072. LBracketLevel := 0; {Stop compiler whining}
  5073. LInQuotesInsideBrackets := False; {Stop compiler whining}
  5074. LInPart := 0; {0 is not in a part, 1 is in a quote-delimited part, 2 is in a bracketted part, 3 is a word}
  5075. Trim(APartString);
  5076. for Ln := 1 to Length(APartString) do begin
  5077. if LInPart = 1 then begin
  5078. if APartString[Ln] = '"' then begin {Do not Localize}
  5079. LParam := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5080. AParams.Add(LParam);
  5081. LInPart := 0;
  5082. end;
  5083. end else if LInPart = 2 then begin
  5084. //We have to watch out that we don't close this entry on a closing bracket within
  5085. //quotes, like ("Blah" "Blah)Blah"), so monitor if we are in quotes within brackets.
  5086. if APartString[Ln] = '"' then begin {Do not Localize}
  5087. LInQuotesInsideBrackets := not LInQuotesInsideBrackets;
  5088. end else begin
  5089. //Brackets don't count if they are within quoted strings...
  5090. if LInQuotesInsideBrackets = False then begin
  5091. if APartString[Ln] = '(' then begin {Do not Localize}
  5092. Inc(LBracketLevel);
  5093. end else if APartString[Ln] = ')' then begin {Do not Localize}
  5094. Dec(LBracketLevel);
  5095. if LBracketLevel = 0 then begin
  5096. if AKeepBrackets then begin
  5097. LParam := Copy(APartString, LStartPos, Ln-LStartPos+1);
  5098. end else begin
  5099. LParam := Copy(APartString, LStartPos+1, Ln-LStartPos-1);
  5100. end;
  5101. AParams.Add(LParam);
  5102. LInPart := 0;
  5103. end;
  5104. end;
  5105. end;
  5106. end;
  5107. end else if LInPart = 3 then begin
  5108. if APartString[Ln] = ' ' then begin {Do not Localize}
  5109. LParam := Copy(APartString, LStartPos, Ln-LStartPos);
  5110. AParams.Add(LParam);
  5111. LInPart := 0;
  5112. end;
  5113. end else if APartString[Ln] = '"' then begin {Do not Localize}
  5114. {Start of a quoted param like "text"}
  5115. LStartPos := Ln;
  5116. LInPart := 1;
  5117. end else if APartString[Ln] = '(' then begin {Do not Localize}
  5118. {Start of a set of paired parameter/value strings within brackets,
  5119. such as ("charset" "us-ascii"). Note these can be nested (bracket pairs
  5120. within bracket pairs) }
  5121. LStartPos := Ln;
  5122. LInPart := 2;
  5123. LBracketLevel := 1;
  5124. LInQuotesInsideBrackets := False;
  5125. end else if APartString[Ln] <> ' ' then begin {Do not Localize}
  5126. {Start of an entry like 12345}
  5127. LStartPos := Ln;
  5128. LInPart := 3;
  5129. end;
  5130. end;
  5131. {We could be in an entry when we hit the end of the line...}
  5132. if LInPart = 3 then begin
  5133. LParam := Copy(APartString, LStartPos, MaxInt);
  5134. AParams.Add(LParam);
  5135. end else if LInPart = 2 then begin
  5136. if AKeepBrackets then begin
  5137. LParam := Copy(APartString, LStartPos, MaxInt);
  5138. end else begin
  5139. LParam := Copy(APartString, LStartPos+1, MaxInt);
  5140. end;
  5141. if ((AKeepBrackets = False) and (LParam[Length(LParam)] = ')')) then begin {Do not Localize}
  5142. LParam := Copy(LParam, 1, Length(LParam)-1);
  5143. end;
  5144. AParams.Add(LParam);
  5145. end else if LInPart = 1 then begin
  5146. LParam := Copy(APartString, LStartPos+1, MaxInt);
  5147. if LParam[Length(LParam)] = '"' then begin {Do not Localize}
  5148. LParam := Copy(LParam, 1, Length(LParam)-1);
  5149. end;
  5150. AParams.Add(LParam);
  5151. end;
  5152. end;
  5153. function TIdIMAP4.ParseBodyStructureSectionAsEquates(AParam: string): string;
  5154. {Convert:
  5155. "Name1" "Value1" "Name2" "Value2"
  5156. to:
  5157. ; Name1="Value1"; Name2="Value2"
  5158. }
  5159. var
  5160. LParse: TIdStringList;
  5161. LN: integer;
  5162. begin
  5163. Result := ''; {Do not Localize}
  5164. if ((AParam = '') or (AParam = 'NIL')) then begin {Do not Localize}
  5165. Exit;
  5166. end;
  5167. LParse := TIdStringList.Create;
  5168. BreakApartParamsInQuotes(AParam, LParse); {Do not Localize}
  5169. if LParse.Count < 2 then begin
  5170. Exit;
  5171. end;
  5172. if ((LParse.Count mod 2) <> 0) then begin
  5173. Exit;
  5174. end;
  5175. for LN := 0 to ((LParse.Count div 2)-1) do begin
  5176. Result := Result + '; ' + Copy(LParse[LN*2], 2, Length(LParse[LN*2])-2) + '=' + LParse[(LN*2)+1]; {Do not Localize}
  5177. end;
  5178. LParse.Free;
  5179. end;
  5180. function TIdIMAP4.ParseBodyStructureSectionAsEquates2(AParam: string): string;
  5181. {Convert:
  5182. "Name1" ("Name2" "Value2")
  5183. to:
  5184. Name1; Name2="Value2"
  5185. }
  5186. var
  5187. LParse: TIdStringList;
  5188. LParams: string;
  5189. begin
  5190. Result := ''; {Do not Localize}
  5191. if ((AParam = '') or (AParam = 'NIL')) then begin {Do not Localize}
  5192. Exit;
  5193. end;
  5194. LParse := TIdStringList.Create;
  5195. BreakApart(AParam, ' ', LParse); {Do not Localize}
  5196. if LParse.Count < 3 then begin
  5197. Exit;
  5198. end;
  5199. LParams := Copy(AParam, Pos('(', AParam)+1, MaxInt); {Do not Localize}
  5200. LParams := Copy(LParams, 1, Length(LParams)-1);
  5201. LParams := ParseBodyStructureSectionAsEquates(LParams);
  5202. if LParams <> '' then begin {Do not Localize}
  5203. Result := Copy(LParse[0], 2, Length(LParse[0])-2) + LParams;
  5204. end;
  5205. LParse.Free;
  5206. end;
  5207. function TIdIMAP4.GetNextWord(AParam: string): string;
  5208. var
  5209. LPos: integer;
  5210. begin
  5211. Result := ''; {Do not Localize}
  5212. Trim(AParam);
  5213. LPos := Pos(' ', AParam); {Do not Localize}
  5214. if LPos = 0 then begin
  5215. Exit;
  5216. end;
  5217. Result := Copy(AParam, 1, LPos-1);
  5218. end;
  5219. function TIdIMAP4.GetNextQuotedParam(AParam: string; ARemoveQuotes: Boolean): string;
  5220. {If AParam is:
  5221. "file name.ext" NIL NIL
  5222. then this returns:
  5223. "file name.ext"
  5224. Note it returns the quotes, UNLESS ARemoveQuotes is True.
  5225. Also note that if AParam does NOT start with a quote, it returns the next word.
  5226. }
  5227. var
  5228. LN: integer;
  5229. LPos: integer;
  5230. begin
  5231. {CCB: Modified code so it did not access past the end of the string if
  5232. AParam was not actually in quotes (e.g. the MIME boundary parameter
  5233. is only optionally in quotes).}
  5234. LN := 1;
  5235. {Skip any preceding spaces...}
  5236. while AParam[LN] = ' ' do begin {Do not Localize}
  5237. LN := LN + 1;
  5238. end;
  5239. if AParam[LN] <> '"' then begin {Do not Localize}
  5240. {Not actually enclosed in quotes. Must be a single word.}
  5241. AParam := Copy(AParam, LN, MaxInt);
  5242. LPos := Pos(' ', AParam); {Do not Localize}
  5243. if LPos > 0 then begin
  5244. {Strip off this word...}
  5245. Result := Copy(AParam, 1, LPos-1);
  5246. end else begin
  5247. {This is the last word on the line, return it all...}
  5248. Result := AParam;
  5249. end;
  5250. end else begin
  5251. {It starts with a quote...}
  5252. AParam := Copy(AParam, LN, MaxInt);
  5253. LN := 2;
  5254. while AParam[LN] <> '"' do begin {Do not Localize}
  5255. LN := LN + 1;
  5256. end;
  5257. Result := Copy(AParam, 1, LN);
  5258. if ARemoveQuotes then begin
  5259. Result := Copy(Result, 2, Length(Result)-2);
  5260. end;
  5261. end;
  5262. end;
  5263. procedure TIdIMAP4.BreakApartParamsInQuotes(const AParam: string; var AParsedList: TIdStringList);
  5264. var
  5265. Ln : Integer;
  5266. LStartPos: Integer;
  5267. begin
  5268. LStartPos := -1;
  5269. AParsedList.Clear;
  5270. for Ln := 1 to Length(AParam) do begin
  5271. if AParam[LN] = '"' then begin {Do not Localize}
  5272. if LStartPos > -1 then begin
  5273. {The end of a quoted parameter...}
  5274. AParsedList.Add(Copy(AParam, LStartPos, LN-LStartPos+1));
  5275. LStartPos := -1;
  5276. end else begin
  5277. {The start of a quoted parameter...}
  5278. LStartPos := Ln;
  5279. end;
  5280. end;
  5281. end;
  5282. end;
  5283. procedure TIdIMAP4.ParseExpungeResult(AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  5284. var
  5285. Ln : Integer;
  5286. LSlExpunge : TIdStringList;
  5287. begin
  5288. LSlExpunge := TIdStringList.Create;
  5289. SetLength ( AMB.DeletedMsgs, 0 );
  5290. try
  5291. if ( ACmdResultDetails.Count > 1 ) then begin
  5292. for Ln := 0 to ( ACmdResultDetails.Count - 1 ) do begin
  5293. BreakApart ( ACmdResultDetails[Ln], ' ', LSlExpunge ); {Do not Localize}
  5294. if (TextIsSame(LSlExpunge[1], IMAP4Commands[cmdExpunge])) then begin
  5295. SetLength ( AMB.DeletedMsgs, ( Length ( AMB.DeletedMsgs ) + 1 ) );
  5296. AMB.DeletedMsgs[Length ( AMB.DeletedMsgs ) - 1] := StrToInt ( LSlExpunge[0] );
  5297. end;
  5298. LSlExpunge.Clear;
  5299. end;
  5300. end;
  5301. finally
  5302. LSlExpunge.Free;
  5303. end;
  5304. end;
  5305. procedure TIdIMAP4.ParseMessageFlagString(AFlagsList: String; var AFlags: TIdMessageFlagsSet);
  5306. {CC5: Note this only supports the system flags defined in RFC 2060.}
  5307. var LSlFlags : TIdStringList;
  5308. Ln : Integer;
  5309. begin
  5310. LSlFlags := TIdStringList.Create;
  5311. AFlags := [];
  5312. BreakApart ( AFlagsList, ' ', LSlFlags ); {Do not Localize}
  5313. try
  5314. for Ln := 0 to ( LSlFlags.Count - 1 ) do begin
  5315. if (TextIsSame(LSlFlags[Ln], MessageFlags[mfAnswered])) then begin
  5316. AFlags := AFlags + [mfAnswered];
  5317. end else if (TextIsSame(LSlFlags[Ln], MessageFlags[mfFlagged])) then begin
  5318. AFlags := AFlags + [mfFlagged];
  5319. end else if (TextIsSame(LSlFlags[Ln], MessageFlags[mfDeleted])) then begin
  5320. AFlags := AFlags + [mfDeleted];
  5321. end else if (TextIsSame(LSlFlags[Ln], MessageFlags[mfDraft])) then begin
  5322. AFlags := AFlags + [mfDraft];
  5323. end else if (TextIsSame(LSlFlags[Ln], MessageFlags[mfSeen])) then begin
  5324. AFlags := AFlags + [mfSeen];
  5325. end else if (TextIsSame(LSlFlags[Ln], MessageFlags[mfRecent])) then begin
  5326. AFlags := AFlags + [mfRecent];
  5327. end;
  5328. end;
  5329. finally
  5330. LSlFlags.Free;
  5331. end;
  5332. end;
  5333. procedure TIdIMAP4.ParseMailBoxAttributeString(AAttributesList: String; var AAttributes: TIdMailBoxAttributesSet);
  5334. var LSlAttributes : TIdStringList;
  5335. Ln : Integer;
  5336. begin
  5337. LSlAttributes := TIdStringList.Create;
  5338. AAttributes := [];
  5339. BreakApart ( AAttributesList, ' ', LSlAttributes ); {Do not Localize}
  5340. try
  5341. for Ln := 0 to ( LSlAttributes.Count - 1 ) do begin
  5342. if (TextIsSame(LSlAttributes[Ln], MailBoxAttributes[maNoinferiors])) then begin
  5343. AAttributes := AAttributes + [maNoinferiors];
  5344. end else if (TextIsSame(LSlAttributes[Ln], MailBoxAttributes[maNoselect])) then begin
  5345. AAttributes := AAttributes + [maNoselect];
  5346. end else if (TextIsSame(LSlAttributes[Ln], MailBoxAttributes[maMarked])) then begin
  5347. AAttributes := AAttributes + [maMarked];
  5348. end else if (TextIsSame(LSlAttributes[Ln], MailBoxAttributes[maUnmarked])) then begin
  5349. AAttributes := AAttributes + [maUnmarked];
  5350. end;
  5351. end;
  5352. finally
  5353. LSlAttributes.Free;
  5354. end;
  5355. end;
  5356. procedure TIdIMAP4.ParseSearchResult(AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  5357. var Ln: Integer;
  5358. LSlSearch: TIdStringList;
  5359. begin
  5360. LSlSearch := TIdStringList.Create;
  5361. SetLength ( AMB.SearchResult, 0 );
  5362. try
  5363. if ACmdResultDetails.Count > 0 then begin
  5364. if ( ( Pos ( IMAP4Commands[cmdSearch], ACmdResultDetails[0] ) > 0 )
  5365. ) then begin
  5366. BreakApart ( ACmdResultDetails[0], ' ', LSlSearch ); {Do not Localize}
  5367. for Ln := 1 to ( LSlSearch.Count - 1 ) do begin
  5368. SetLength ( AMB.SearchResult, ( Length ( AMB.SearchResult ) + 1 ) );
  5369. AMB.SearchResult[Length ( AMB.SearchResult ) - 1] := StrToInt ( LSlSearch[Ln] );
  5370. end;
  5371. end;
  5372. end;
  5373. finally
  5374. LSlSearch.Free;
  5375. end;
  5376. end;
  5377. procedure TIdIMAP4.ParseStatusResult(AMB: TIdMailBox; ACmdResultDetails: TIdStrings);
  5378. var Ln : Integer;
  5379. LStr : String;
  5380. LSlStatus : TIdStringList;
  5381. begin
  5382. LSlStatus := TIdStringList.Create;
  5383. try
  5384. if ACmdResultDetails.Count > 0 then begin
  5385. if ( ( Pos ( IMAP4Commands[cmdStatus], ACmdResultDetails[0] ) > 0 )
  5386. ) then begin
  5387. LStr := Copy ( ACmdResultDetails[0],
  5388. ( Pos ( IMAP4Commands[cmdStatus], ACmdResultDetails[0] ) +
  5389. Length ( IMAP4Commands[cmdStatus] ) ),
  5390. Length ( ACmdResultDetails[0] ) );
  5391. AMB.Name := Trim ( Copy ( LStr, 1, ( Pos ( '(', LStr ) - 1 ) ) ); {Do not Localize}
  5392. LStr := Copy ( LStr, ( Pos ( '(', LStr ) + 1 ), {Do not Localize}
  5393. ( Length ( LStr ) - Pos ( '(', LStr ) - 1 ) ); {Do not Localize}
  5394. BreakApart ( LStr, ' ', LSlStatus ); {Do not Localize}
  5395. Ln := 0;
  5396. while ( Ln < LSlStatus.Count ) do begin
  5397. if (TextIsSame(LSlStatus[Ln], IMAP4StatusDataItem[mdMessages])) then begin
  5398. AMB.TotalMsgs := StrToInt ( LSlStatus[Ln + 1] );
  5399. Ln := Ln + 2;
  5400. end else if (TextIsSame(LSlStatus[Ln], IMAP4StatusDataItem[mdRecent])) then begin
  5401. AMB.RecentMsgs := StrToInt ( LSlStatus[Ln + 1] );
  5402. Ln := Ln + 2;
  5403. end else if (TextIsSame(LSlStatus[Ln], IMAP4StatusDataItem[mdUnseen])) then begin
  5404. AMB.UnseenMsgs := StrToInt ( LSlStatus[Ln + 1] );
  5405. Ln := Ln + 2;
  5406. end else if (TextIsSame(LSlStatus[Ln], IMAP4StatusDataItem[mdUIDNext])) then begin
  5407. AMB.UIDNext := LSlStatus[Ln + 1];
  5408. Ln := Ln + 2;
  5409. end else if (TextIsSame(LSlStatus[Ln], IMAP4StatusDataItem[mdUIDValidity])) then begin
  5410. AMB.UIDValidity := LSlStatus[Ln + 1];
  5411. Ln := Ln + 2;
  5412. end;
  5413. end;
  5414. end;
  5415. end;
  5416. finally
  5417. LSlStatus.Free;
  5418. end;
  5419. end;
  5420. procedure TIdIMAP4.ParseSelectResult(AMB : TIdMailBox; ACmdResultDetails: TIdStrings);
  5421. var Ln : Integer;
  5422. LStr : String;
  5423. LFlags: TIdMessageFlagsSet;
  5424. begin
  5425. AMB.Clear;
  5426. for Ln := 0 to ( ACmdResultDetails.Count - 1 ) do begin
  5427. if ( Pos ( 'EXISTS', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5428. AMB.TotalMsgs := StrToInt ( Trim ( Copy ( ACmdResultDetails[Ln], 0,
  5429. ( Pos ( 'EXISTS', ACmdResultDetails[Ln] ) - 1 ) ) ) ); {Do not Localize}
  5430. end;
  5431. if ( Pos ( 'RECENT', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5432. AMB.RecentMsgs := StrToInt ( Trim ( Copy ( ACmdResultDetails[Ln], 0,
  5433. ( Pos ( 'RECENT', ACmdResultDetails[Ln] ) - 1 ) ) ) ); {Do not Localize}
  5434. end;
  5435. if ( Pos ( '[UIDVALIDITY', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5436. AMB.UIDValidity := Trim ( Copy ( ACmdResultDetails[Ln],
  5437. ( Pos ( '[UIDVALIDITY', ACmdResultDetails[Ln] ) + {Do not Localize}
  5438. Length ( '[UIDVALIDITY' ) ), {Do not Localize}
  5439. ( Pos ( ']', ACmdResultDetails[Ln] ) - {Do not Localize}
  5440. ( Pos ( '[UIDVALIDITY', ACmdResultDetails[Ln] ) + {Do not Localize}
  5441. Length ( '[UIDVALIDITY' ) ) ) ) ); {Do not Localize}
  5442. end;
  5443. if ( Pos ( '[UIDNEXT', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5444. AMB.UIDNext := Trim ( Copy ( ACmdResultDetails[Ln],
  5445. ( Pos ( '[UIDNEXT', ACmdResultDetails[Ln] ) + {Do not Localize}
  5446. Length ( '[UIDNEXT' ) ), {Do not Localize}
  5447. ( Pos ( ']', ACmdResultDetails[Ln] ) - {Do not Localize}
  5448. ( Pos ( '[UIDNEXT', ACmdResultDetails[Ln] ) + {Do not Localize}
  5449. Length ( '[UIDNEXT' ) ) - 1 ) ) ); {Do not Localize}
  5450. end;
  5451. if ( Pos ( 'FLAGS', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5452. ParseMessageFlagString ( Copy ( ACmdResultDetails[Ln],
  5453. ( Pos ( '(', ACmdResultDetails[Ln] ) + 1 ), {Do not Localize}
  5454. ( Pos ( ')', ACmdResultDetails[Ln] ) - {Do not Localize}
  5455. Pos ( '(', ACmdResultDetails[Ln] ) - 1 ) ), LFlags ); {Do not Localize}
  5456. AMB.Flags := LFlags;
  5457. end;
  5458. if ( Pos ( '[PERMANENTFLAGS', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5459. ParseMessageFlagString ( Copy ( ACmdResultDetails[Ln],
  5460. ( Pos ( '(', ACmdResultDetails[Ln] ) + 1 ), {Do not Localize}
  5461. ( Pos ( ')', ACmdResultDetails[Ln] ) - {Do not Localize}
  5462. Pos ( '(', ACmdResultDetails[Ln] ) - 1 ) ), {Do not Localize}
  5463. LFlags );
  5464. AMB.ChangeableFlags := LFlags;
  5465. end;
  5466. if ( Pos ( '[UNSEEN', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5467. AMB.FirstUnseenMsg := StrToInt ( Trim ( Copy ( ACmdResultDetails[Ln],
  5468. ( Pos ( '[UNSEEN', ACmdResultDetails[Ln] ) + {Do not Localize}
  5469. Length ( '[UNSEEN' ) ), {Do not Localize}
  5470. ( Pos ( ']', ACmdResultDetails[Ln] ) - {Do not Localize}
  5471. ( Pos ( '[UNSEEN', ACmdResultDetails[Ln] ) + {Do not Localize}
  5472. Length ( '[UNSEEN' ) ) ) ) ) ); {Do not Localize}
  5473. end;
  5474. if ( Pos ( '[READ-', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5475. LStr := Trim ( Copy ( ACmdResultDetails[Ln],
  5476. ( Pos ( '[', ACmdResultDetails[Ln] ) ), {Do not Localize}
  5477. ( Pos ( ']', ACmdResultDetails[Ln] ) - Pos ( '[', ACmdResultDetails[Ln] ) + 1 ) ) ); {Do not Localize}
  5478. {CCB: AMB.State ambiguous unless coded response received - default to msReadOnly...}
  5479. if (TextIsSame(LStr, '[READ-WRITE]')) then begin {Do not Localize}
  5480. AMB.State := msReadWrite;
  5481. end else {if AnsiSameText ( LStr, '[READ-ONLY]' ) then} begin {Do not Localize}
  5482. AMB.State := msReadOnly;
  5483. end;
  5484. end;
  5485. if ( Pos ( '[ALERT]', ACmdResultDetails[Ln] ) > 0 ) then begin {Do not Localize}
  5486. LStr := Trim ( Copy ( ACmdResultDetails[Ln],
  5487. ( Pos ( '[ALERT]', ACmdResultDetails[Ln] ) + {Do not Localize}
  5488. Length ( '[ALERT]' ) ), MaxInt ) ); {Do not Localize}
  5489. if ( LStr <> '' ) then begin {Do not Localize}
  5490. DoAlert ( LStr );
  5491. end;
  5492. end;
  5493. end;
  5494. end;
  5495. procedure TIdIMAP4.ParseListResult(AMBList: TIdStringList; ACmdResultDetails: TIdStrings);
  5496. begin
  5497. InternalParseListResult(IMAP4Commands[cmdList], AMBList, ACmdResultDetails);
  5498. end;
  5499. procedure TIdIMAP4.InternalParseListResult(ACmd: string; AMBList: TIdStringList; ACmdResultDetails: TIdStrings);
  5500. var Ln : Integer;
  5501. LSlRetrieve : TIdStringList;
  5502. LStr : String;
  5503. LWord: string;
  5504. begin
  5505. AMBList.Clear;
  5506. LSlRetrieve := TIdStringList.Create;
  5507. try
  5508. for Ln := 0 to ( ACmdResultDetails.Count - 1 ) do begin
  5509. LStr := ACmdResultDetails[Ln];
  5510. //Todo: Get mail box attributes here
  5511. {CC2: Could put mailbox attributes in AMBList's Objects property?}
  5512. {The line is of the form:
  5513. * LIST (\UnMarked \AnotherFlag) "/" "Mailbox name"
  5514. }
  5515. {CCA: code modified because some servers return NIL as the mailbox
  5516. separator, i.e.:
  5517. * LIST (\UnMarked \AnotherFlag) NIL "Mailbox name"
  5518. }
  5519. ParseIntoBrackettedQuotedAndUnquotedParts(LStr, LSlRetrieve, False);
  5520. if LSlRetrieve.Count > 3 then begin
  5521. //Make sure 1st word is LIST (may be an unsolicited response)...
  5522. if (TextIsSame(LSlRetrieve[0], {IMAP4Commands[cmdList]} ACmd)) then begin
  5523. {Get the mailbox separator...}
  5524. LWord := Trim(LSlRetrieve[LSlRetrieve.Count-2]);
  5525. if ( (TextIsSame(LWord, 'NIL')) {Do not Localize}
  5526. or (TextIsSame(LWord, '')) ) then begin
  5527. FMailBoxSeparator := #0;
  5528. end else begin
  5529. FMailBoxSeparator := LWord[1];
  5530. end;
  5531. {Now get the mailbox name...}
  5532. LWord := Trim(LSlRetrieve[LSlRetrieve.Count-1]);
  5533. AMBList.Add ( DoMUTFDecode(LWord) );
  5534. end;
  5535. end;
  5536. end;
  5537. finally
  5538. LSlRetrieve.Free;
  5539. end;
  5540. end;
  5541. procedure TIdIMAP4.ParseLSubResult(AMBList: TIdStringList; ACmdResultDetails: TIdStrings);
  5542. begin
  5543. InternalParseListResult(IMAP4Commands[cmdLSub], AMBList, ACmdResultDetails);
  5544. end;
  5545. procedure TIdIMAP4.ParseEnvelopeResult(AMsg: TIdMessage; ACmdResultStr: String);
  5546. procedure DecodeEnvelopeAddress (const AAddressStr: String; AEmailAddressItem: TIdEmailAddressItem); overload;
  5547. var
  5548. {$IFDEF DOTNET}
  5549. LTemp: string;
  5550. {$ELSE}
  5551. LPChar: PChar;
  5552. {$ENDIF}
  5553. LStr: String;
  5554. begin
  5555. if ( ( AAddressStr[1] = '(' ) and {Do not Localize}
  5556. ( AAddressStr[Length (AAddressStr)] = ')' ) and {Do not Localize}
  5557. Assigned (AEmailAddressItem) ) then begin
  5558. LStr := Copy (AAddressStr, 2, Length (AAddressStr) - 2);
  5559. //Gets the name part
  5560. if (TextIsSame(Copy (LStr, 1, Pos (' ', LStr) - 1), 'NIL')) then begin {Do not Localize}
  5561. LStr := Copy (LStr, Pos (' ', LStr) + 1, MaxInt); {Do not Localize}
  5562. end else begin
  5563. if ( LStr[1] = '{' ) then begin {Do not Localize}
  5564. LStr := Copy (LStr, Pos ('}', LStr) + 1, MaxInt); {Do not Localize}
  5565. AEmailAddressItem.Name := Copy (LStr, 1, Pos ('" ', LStr) - 1); {Do not Localize}
  5566. LStr := Copy (LStr, Pos ('" ', LStr) + 2, MaxInt); {Do not Localize}
  5567. end else begin
  5568. {$IFDEF DOTNET}
  5569. LTemp := Copy (LStr, 1, Pos ('" ', LStr)); {Do not Localize}
  5570. AEmailAddressItem.Name := Copy(LTemp, 2, Length(LTemp)-2); {ExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5571. {$ELSE}
  5572. LPChar := PChar (Copy (LStr, 1, Pos ('" ', LStr))); {Do not Localize}
  5573. AEmailAddressItem.Name := AnsiExtractQuotedStr ( LPChar, '"' ); {Do not Localize}
  5574. {$ENDIF}
  5575. LStr := Copy (LStr, Pos ('" ', LStr) + 2, MaxInt); {Do not Localize}
  5576. end;
  5577. end;
  5578. //Gets the source root part
  5579. if (TextIsSame(Copy (LStr, 1, Pos (' ', LStr) - 1), 'NIL')) then begin {Do not Localize}
  5580. LStr := Copy (LStr, Pos (' ', LStr) + 1, MaxInt); {Do not Localize}
  5581. end else begin
  5582. {$IFDEF DOTNET}
  5583. LTemp := Copy (LStr, 1, Pos ('" ', LStr)); {Do not Localize}
  5584. AEmailAddressItem.Name := Copy(LTemp, 2, Length(LTemp)-2); {AnsiExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5585. {$ELSE}
  5586. LPChar := PChar (Copy (LStr, 1, Pos ('" ', LStr))); {Do not Localize}
  5587. AEmailAddressItem.Name := AnsiExtractQuotedStr ( LPChar, '"' ); {Do not Localize}
  5588. {$ENDIF}
  5589. LStr := Copy (LStr, Pos ('" ', LStr) + 2, MaxInt); {Do not Localize}
  5590. end;
  5591. //Gets the mailbox name part
  5592. if (TextIsSame(Copy (LStr, 1, Pos (' ', LStr) - 1), 'NIL')) then begin {Do not Localize}
  5593. LStr := Copy (LStr, Pos (' ', LStr) + 1, MaxInt); {Do not Localize}
  5594. end else begin
  5595. {$IFDEF DOTNET}
  5596. LTemp := Copy (LStr, 1, Pos ('" ', LStr)); {Do not Localize}
  5597. AEmailAddressItem.Address := Copy(LTemp, 2, Length(LTemp)-2); {AnsiExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5598. {$ELSE}
  5599. LPChar := PChar (Copy (LStr, 1, Pos ('" ', LStr))); {Do not Localize}
  5600. AEmailAddressItem.Address := AnsiExtractQuotedStr ( LPChar, '"' ); {Do not Localize}
  5601. {$ENDIF}
  5602. LStr := Copy (LStr, Pos ('" ', LStr) + 2, MaxInt); {Do not Localize}
  5603. end;
  5604. //Gets the host name part
  5605. if not (TextIsSame(Copy (LStr, 1, MaxInt), 'NIL')) then begin {Do not Localize}
  5606. {$IFDEF DOTNET}
  5607. LTemp := Copy (LStr, 1, MaxInt);
  5608. AEmailAddressItem.Address := AEmailAddressItem.Address + '@' + {Do not Localize}
  5609. Copy(LTemp, 2, Length(LTemp)-2); {AnsiExtractQuotedStr ( LTemp, '"' ); {Do not Localize}
  5610. {$ELSE}
  5611. LPChar := PChar (Copy (LStr, 1, MaxInt));
  5612. AEmailAddressItem.Address := AEmailAddressItem.Address + '@' + {Do not Localize}
  5613. AnsiExtractQuotedStr ( LPChar, '"' ); {Do not Localize}
  5614. {$ENDIF}
  5615. end;
  5616. end;
  5617. end;
  5618. procedure DecodeEnvelopeAddress (const AAddressStr: String; AEmailAddressList: TIdEmailAddressList); overload;
  5619. var LStr: String;
  5620. begin
  5621. if ( ( AAddressStr[1] = '(' ) and {Do not Localize}
  5622. ( AAddressStr[Length (AAddressStr)] = ')' ) and {Do not Localize}
  5623. Assigned (AEmailAddressList) ) then begin
  5624. LStr := Copy (AAddressStr, 2, Length (AAddressStr) - 2);
  5625. while ( Pos (')', LStr) > 0 ) do begin {Do not Localize}
  5626. DecodeEnvelopeAddress (Copy (LStr, 1, Pos (')', LStr)), AEmailAddressList.Add); {Do not Localize}
  5627. LStr := Trim (Copy (LStr, Pos (')', LStr) + 1, MaxInt)); {Do not Localize}
  5628. end;
  5629. end;
  5630. end;
  5631. var LStr: String;
  5632. {$IFNDEF DOTNET}
  5633. LPChar: PChar;
  5634. {$ENDIF}
  5635. begin
  5636. //The fields of the envelope structure are in the
  5637. //following order: date, subject, from, sender,
  5638. //reply-to, to, cc, bcc, in-reply-to, and message-id.
  5639. //The date, subject, in-reply-to, and message-id
  5640. //fields are strings. The from, sender, reply-to,
  5641. //to, cc, and bcc fields are parenthesized lists of
  5642. //address structures.
  5643. //An address structure is a parenthesized list that
  5644. //describes an electronic mail address. The fields
  5645. //of an address structure are in the following order:
  5646. //personal name, [SMTP] at-domain-list (source
  5647. //route), mailbox name, and host name.
  5648. //* 4 FETCH (ENVELOPE ("Sun, 15 Jul 2001 02:56:45 -0700 (PDT)" "Your Borland Commu
  5649. //nity Account Activation Code" (("Borland Community" NIL "mailbot" "borland.com")
  5650. //) NIL NIL (("" NIL "name" "company.com")) NIL NIL NIL "<200107150956.CAA1
  5651. //8152@borland.com>"))
  5652. {CC5: Cleared out any existing fields to avoid mangling new entries with old/stale ones.}
  5653. //Extract envelope date field
  5654. AMsg.Date := 0;
  5655. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5656. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5657. end else begin
  5658. {$IFDEF DOTNET}
  5659. LStr := Copy (ACmdResultStr, 1, Pos ('" ', ACmdResultStr)); {Do not Localize}
  5660. LStr := Copy(LStr, 2, Length(LStr)-2); {AnsiExtractQuotedStr (LStr, '"'); {Do not Localize}
  5661. {$ELSE}
  5662. LPChar := PChar (Copy (ACmdResultStr, 1, Pos ('" ', ACmdResultStr))); {Do not Localize}
  5663. LStr := AnsiExtractQuotedStr (LPChar, '"'); {Do not Localize}
  5664. {$ENDIF}
  5665. AMsg.Date := GMTToLocalDateTime (LStr);
  5666. ACmdResultStr := Copy (ACmdResultStr, Pos ('" ', ACmdResultStr) + 2, MaxInt); {Do not Localize}
  5667. end;
  5668. //Extract envelope subject field
  5669. AMsg.Subject := ''; {Do not Localize}
  5670. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5671. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5672. end else begin
  5673. if ( ACmdResultStr[1] = '{' ) then begin {Do not Localize}
  5674. ACmdResultStr := Copy (ACmdResultStr, Pos ('}', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5675. LStr := Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1); {Do not Localize}
  5676. AMsg.Subject := LStr;
  5677. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5678. end else begin
  5679. {$IFDEF DOTNET}
  5680. LStr := Copy (ACmdResultStr, 1, Pos ('" ', ACmdResultStr)); {Do not Localize}
  5681. LStr := Copy(LStr, 2, Length(LStr)-2); {AnsiExtractQuotedStr (LStr, '"'); {Do not Localize}
  5682. {$ELSE}
  5683. LPChar := PChar (Copy (ACmdResultStr, 1, Pos ('" ', ACmdResultStr))); {Do not Localize}
  5684. LStr := AnsiExtractQuotedStr (LPChar, '"'); {Do not Localize}
  5685. {$ENDIF}
  5686. AMsg.Subject := LStr;
  5687. ACmdResultStr := Copy (ACmdResultStr, Pos ('" ', ACmdResultStr) + 2, MaxInt); {Do not Localize}
  5688. end;
  5689. end;
  5690. //Extract envelope from field
  5691. AMsg.FromList.Clear;
  5692. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5693. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5694. end else begin
  5695. //LStr := Copy (ACmdResultStr, 2, Pos (')) ', ACmdResultStr) - 1); {Do not Localize}
  5696. LStr := Copy (ACmdResultStr, 1, Pos (')) ', ACmdResultStr) + 1); {Do not Localize}
  5697. DecodeEnvelopeAddress (LStr, AMsg.FromList);
  5698. ACmdResultStr := Copy (ACmdResultStr, Pos (')) ', ACmdResultStr) + 3, MaxInt); {Do not Localize}
  5699. end;
  5700. //Extract envelope sender field
  5701. AMsg.Sender.Name := ''; {Do not Localize}
  5702. AMsg.Sender.Address := ''; {Do not Localize}
  5703. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5704. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5705. end else begin
  5706. {CC5: Fix parsing of sender...}
  5707. LStr := Copy (ACmdResultStr, 2, Pos (')) ', ACmdResultStr) - 1); {Do not Localize}
  5708. DecodeEnvelopeAddress (LStr, AMsg.Sender);
  5709. ACmdResultStr := Copy (ACmdResultStr, Pos (')) ', ACmdResultStr) + 3, MaxInt); {Do not Localize}
  5710. end;
  5711. //Extract envelope reply-to field
  5712. AMsg.ReplyTo.Clear;
  5713. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5714. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5715. end else begin
  5716. LStr := Copy (ACmdResultStr, 1, Pos (')) ', ACmdResultStr) + 1); {Do not Localize}
  5717. DecodeEnvelopeAddress (LStr, AMsg.ReplyTo);
  5718. ACmdResultStr := Copy (ACmdResultStr, Pos (')) ', ACmdResultStr) + 3, MaxInt); {Do not Localize}
  5719. end;
  5720. //Extract envelope to field
  5721. AMsg.Recipients.Clear;
  5722. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5723. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5724. end else begin
  5725. LStr := Copy (ACmdResultStr, 1, Pos (')) ', ACmdResultStr) + 1); {Do not Localize}
  5726. DecodeEnvelopeAddress (LStr, AMsg.Recipients);
  5727. ACmdResultStr := Copy (ACmdResultStr, Pos (')) ', ACmdResultStr) + 3, MaxInt); {Do not Localize}
  5728. end;
  5729. //Extract envelope cc field
  5730. AMsg.CCList.Clear;
  5731. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5732. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5733. end else begin
  5734. LStr := Copy (ACmdResultStr, 1, Pos (')) ', ACmdResultStr) + 1); {Do not Localize}
  5735. DecodeEnvelopeAddress (LStr, AMsg.CCList);
  5736. ACmdResultStr := Copy (ACmdResultStr, Pos (')) ', ACmdResultStr) + 3, MaxInt); {Do not Localize}
  5737. end;
  5738. //Extract envelope bcc field
  5739. AMsg.BccList.Clear;
  5740. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5741. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5742. end else begin
  5743. LStr := Copy (ACmdResultStr, 1, Pos (')) ', ACmdResultStr) + 1); {Do not Localize}
  5744. DecodeEnvelopeAddress (LStr, AMsg.BccList);
  5745. ACmdResultStr := Copy (ACmdResultStr, Pos (')) ', ACmdResultStr) + 3, MaxInt); {Do not Localize}
  5746. end;
  5747. //Extract envelope in-reply-to field
  5748. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5749. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5750. end else begin
  5751. {$IFDEF DOTNET}
  5752. LStr := Copy (ACmdResultStr, 1, Pos ('" ', ACmdResultStr)); {Do not Localize}
  5753. LStr := Copy(LStr, 2, Length(LStr)-2); {AnsiExtractQuotedStr (LStr, '"'); {Do not Localize}
  5754. {$ELSE}
  5755. LPChar := PChar (Copy (ACmdResultStr, 1, Pos ('" ', ACmdResultStr))); {Do not Localize}
  5756. LStr := AnsiExtractQuotedStr (LPChar, '"'); {Do not Localize}
  5757. {$ENDIF}
  5758. AMsg.InReplyTo := LStr;
  5759. ACmdResultStr := Copy (ACmdResultStr, Pos ('" ', ACmdResultStr) + 2, MaxInt); {Do not Localize}
  5760. end;
  5761. //Extract envelope message-id field
  5762. AMsg.MsgId := ''; {Do not Localize}
  5763. if (TextIsSame(Copy (ACmdResultStr, 1, Pos (' ', ACmdResultStr) - 1), 'NIL')) then begin {Do not Localize}
  5764. ACmdResultStr := Copy (ACmdResultStr, Pos (' ', ACmdResultStr) + 1, MaxInt); {Do not Localize}
  5765. end else begin
  5766. {$IFDEF DOTNET}
  5767. LStr := Copy(ACmdResultStr, 2, Length(ACmdResultStr)-2); {AnsiExtractQuotedStr (ACmdResultStr, '"'); {Do not Localize}
  5768. {$ELSE}
  5769. LPChar := PChar (ACmdResultStr);
  5770. LStr := AnsiExtractQuotedStr (LPChar, '"'); {Do not Localize}
  5771. {$ENDIF}
  5772. AMsg.MsgId := Trim (LStr);
  5773. end;
  5774. end;
  5775. function TIdIMAP4.ParseLastCmdResult(ALine: string; AExpectedCommand: string; AExpectedIMAPFunction: array of string): Boolean;
  5776. var
  5777. LPos: integer;
  5778. LWord: string;
  5779. LWords: TIdStringList;
  5780. LN: Integer;
  5781. LWordInExpectedIMAPFunction: Boolean;
  5782. begin
  5783. Result := False;
  5784. LWordInExpectedIMAPFunction := False;
  5785. FLineStruct.HasStar := False;
  5786. FLineStruct.MessageNumber := '';
  5787. FLineStruct.Command := '';
  5788. FLineStruct.UID := '';
  5789. FLineStruct.Complete := True;
  5790. FLineStruct.IMAPFunction := '';
  5791. FLineStruct.IMAPValue := '';
  5792. FLineStruct.ByteCount := -1;
  5793. Trim(ALine); //Can get garbage like a spurious CR at start
  5794. //Look for (optional) * at start...
  5795. LPos := Pos(' ', ALine); {Do not Localize}
  5796. if LPos < 1 then begin
  5797. Exit; //Nothing on this line
  5798. end;
  5799. LWord := Copy(ALine, 1, LPos-1);
  5800. if LWord = '*' then begin {Do not Localize}
  5801. FLineStruct.HasStar := True;
  5802. ALine := Copy(ALine, LPos+1, MAXINT);
  5803. LPos := Pos(' ', ALine); {Do not Localize}
  5804. if LPos < 1 then begin
  5805. Exit; //Line ONLY had a *
  5806. end;
  5807. LWord := Copy(ALine, 1, LPos-1);
  5808. end;
  5809. //Look for (optional) message number next...
  5810. if TIdReplyIMAP4(FLastCmdResult).IsItANumber(LWord) = True then begin
  5811. FLineStruct.MessageNumber := LWord;
  5812. ALine := Copy(ALine, LPos+1, MAXINT);
  5813. LPos := Pos(' ', ALine); {Do not Localize}
  5814. if LPos < 1 then begin
  5815. Exit; //Line ONLY had a * 67
  5816. end;
  5817. LWord := Copy(ALine, 1, LPos-1);
  5818. end;
  5819. //We should have a valid IMAP command word now, like FETCH, LIST or SEARCH...
  5820. if PosInStrArray(LWord, IMAP4Commands) = -1 then begin
  5821. Exit; //Should have been a command, give up.
  5822. end;
  5823. FLineStruct.Command := LWord;
  5824. if ((AExpectedCommand = '') or (FLineStruct.Command = AExpectedCommand)) then begin
  5825. Result := True;
  5826. end;
  5827. ALine := Copy(ALine, Length(LWord)+2, MAXINT);
  5828. if ALine[1] <> '(' then begin {Do not Localize}
  5829. //This is a line like '* SEARCH 34 56', the '34 56' is the value (result)...
  5830. FLineStruct.IMAPValue := ALine;
  5831. Exit;
  5832. end;
  5833. //This is a line like '* 9 FETCH (UID 47 RFC822.SIZE 3456)', i.e. with a bracketted response.
  5834. //See is it complete (has a closing bracket) or does it continue on other lines...
  5835. ALine := Copy(ALine, 2, MAXINT);
  5836. if Copy(ALine, Length(ALine), 1) = ')' then begin {Do not Localize}
  5837. ALine := Copy(ALine, 1, Length(ALine) - 1); //Strip trailing bracket
  5838. FLineStruct.Complete := True;
  5839. end else begin
  5840. FLineStruct.Complete := False;
  5841. end;
  5842. //These words left may occur in different order. Find & delete those we know.
  5843. LWords := TIdStringList.Create;
  5844. ParseIntoBrackettedQuotedAndUnquotedParts(ALine, LWords, False);
  5845. // LWords.Clear;
  5846. // BreakApart (ALine, ' ', LWords); {Do not Localize}
  5847. //See does it have a trailing byte count...
  5848. LWord := LWords[LWords.Count-1];
  5849. if ((LWord[1] = '{') and (LWord[Length(LWord)] = '}')) then begin
  5850. //It ends in a byte count...
  5851. LWord := Copy(LWord, 2, Length(LWord)-2);
  5852. if UpperCase(LWord) = 'NIL' then begin {do not localize}
  5853. FLineStruct.ByteCount := 0;
  5854. end else begin
  5855. FLineStruct.ByteCount := StrToInt(LWord);
  5856. end;
  5857. LWords.Delete(LWords.Count-1);
  5858. end;
  5859. if FLineStruct.Complete = False then begin
  5860. //The command in this case should be the last word...
  5861. if LWords.Count > 0 then begin
  5862. FLineStruct.IMAPFunction := LWords[LWords.Count-1];
  5863. LWords.Delete(LWords.Count-1);
  5864. end;
  5865. end;
  5866. //See is the UID present...
  5867. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdUID]); {Do not Localize}
  5868. if LPos <> -1 then begin
  5869. //The UID is the word after 'UID'...
  5870. if LPos < LWords.Count-1 then begin
  5871. FLineStruct.UID := LWords[LPos+1];
  5872. LWords.Delete(LPos+1);
  5873. LWords.Delete(LPos);
  5874. end;
  5875. //if IMAP4FetchDataItem[fdUID] in AExpectedIMAPFunction then begin
  5876. if PosInStrArray(IMAP4FetchDataItem[fdUID], AExpectedIMAPFunction) > -1 then begin
  5877. LWordInExpectedIMAPFunction := True;
  5878. end;
  5879. end;
  5880. //See are the FLAGS present...
  5881. LPos := LWords.IndexOf(IMAP4FetchDataItem[fdFlags]); {Do not Localize}
  5882. if LPos <> -1 then begin
  5883. //The FLAGS are in the "word" (really a string) after 'FLAGS'...
  5884. if LPos < LWords.Count-1 then begin
  5885. //FLineStruct.Flags := LWords[LPos+1];
  5886. ParseMessageFlagString ( LWords[LPos+1], FLineStruct.Flags );
  5887. LWords.Delete(LPos+1);
  5888. LWords.Delete(LPos);
  5889. end;
  5890. if PosInStrArray(IMAP4FetchDataItem[fdFlags], AExpectedIMAPFunction) > -1 then begin
  5891. LWordInExpectedIMAPFunction := True;
  5892. end;
  5893. end;
  5894. if Length(AExpectedIMAPFunction) > 0 then begin
  5895. //See is what we want present...
  5896. for LN := 0 to Length(AExpectedIMAPFunction)-1 do begin
  5897. //if PosInStrArray(AExpectedIMAPFunction[LN], LWords) > -1 then begin
  5898. LPos := LWords.IndexOf(AExpectedIMAPFunction[LN]); {Do not Localize}
  5899. if LPos <> -1 then begin
  5900. FLineStruct.IMAPFunction := LWords[LPos];
  5901. LWordInExpectedIMAPFunction := True;
  5902. if LPos < LWords.Count-1 then begin
  5903. //There is a parameter after our function...
  5904. FLineStruct.IMAPValue := LWords[LPos+1];
  5905. end;
  5906. end;
  5907. end;
  5908. end else begin
  5909. //See is there function/value items left. There may not be, such as
  5910. //'* 9 FETCH (UID 45)' in response to a GetUID request.
  5911. if FLineStruct.Complete = True then begin
  5912. if LWords.Count > 1 then begin
  5913. FLineStruct.IMAPFunction := LWords[LWords.Count-2];
  5914. FLineStruct.IMAPValue := LWords[LWords.Count-1];
  5915. end;
  5916. end;
  5917. end;
  5918. Result := False;
  5919. if ((AExpectedCommand = '') or (FLineStruct.Command = AExpectedCommand)) then begin
  5920. //The AExpectedCommand is correct, now need to check the AExpectedIMAPFunction...
  5921. if ((Length(AExpectedIMAPFunction) = 0) or (LWordInExpectedIMAPFunction = True)) then begin
  5922. Result := True;
  5923. end;
  5924. end;
  5925. LWords.Free;
  5926. end;
  5927. procedure TIdIMAP4.ParseLastCmdResultButAppendInfo(ALine: string);
  5928. {This ADDS any parseable info from ALine to FLineStruct (set up from a previous ParseLastCmdResult
  5929. call)}
  5930. var
  5931. LPos: integer;
  5932. LWords: TIdStringList;
  5933. //LN: Integer;
  5934. begin
  5935. Trim(ALine); //Can get garbage like a spurious CR at start
  5936. {We may have an initial or ending bracket, like ") UID 5" or "UID 5)"}
  5937. if ((Length(ALine) > 0) and (ALine[1] = ')')) then begin {Do not Localize}
  5938. ALine := Trim(Copy(ALine, 2, MAXINT));
  5939. end;
  5940. if ((Length(ALine) > 0) and (ALine[Length(ALine)] = ')')) then begin {Do not Localize}
  5941. ALine := Trim(Copy(ALine, 1, Length(ALine)-1));
  5942. end;
  5943. //These words left may occur in different order. Find & delete those we know.
  5944. LWords := TIdStringList.Create;
  5945. ParseIntoBrackettedQuotedAndUnquotedParts(ALine, LWords, False);
  5946. //See is the UID present...
  5947. LPos := LWords.IndexOf('UID'); {Do not Localize}
  5948. if LPos <> -1 then begin
  5949. //The UID is the word after 'UID'...
  5950. FLineStruct.UID := LWords[LPos+1];
  5951. LWords.Delete(LPos+1);
  5952. LWords.Delete(LPos);
  5953. end;
  5954. //See are the FLAGS present...
  5955. LPos := LWords.IndexOf('FLAGS'); {Do not Localize}
  5956. if LPos <> -1 then begin
  5957. //The FLAGS are in the "word" (really a string) after 'FLAGS'...
  5958. //FLineStruct.Flags := LWords[LPos+1];
  5959. ParseMessageFlagString ( LWords[LPos+1], FLineStruct.Flags );
  5960. LWords.Delete(LPos+1);
  5961. LWords.Delete(LPos);
  5962. end;
  5963. LWords.Free;
  5964. end;
  5965. { ...Parser Functions }
  5966. function TIdIMAP4.ArrayToNumberStr (const AMsgNumList: array of Integer): String;
  5967. var Ln : Integer;
  5968. begin
  5969. for Ln := 0 to ( Length ( AMsgNumList ) - 1 ) do begin
  5970. Result := Result + IntToStr ( AMsgNumList[Ln] ) + ','; {Do not Localize}
  5971. end;
  5972. SetLength ( Result, ( Length ( Result ) - 1 ) );
  5973. end;
  5974. function TIdIMAP4.MessageFlagSetToStr(const AFlags: TIdMessageFlagsSet): String;
  5975. begin
  5976. Result := ''; {Do not Localize}
  5977. if mfAnswered in AFlags then begin
  5978. Result := Result + MessageFlags[mfAnswered] + ' '; {Do not Localize}
  5979. end;
  5980. if mfFlagged in AFlags then begin
  5981. Result := Result + MessageFlags[mfFlagged] + ' '; {Do not Localize}
  5982. end;
  5983. if mfDeleted in AFlags then begin
  5984. Result := Result + MessageFlags[mfDeleted] + ' '; {Do not Localize}
  5985. end;
  5986. if mfDraft in AFlags then begin
  5987. Result := Result + MessageFlags[mfDraft] + ' '; {Do not Localize}
  5988. end;
  5989. if mfSeen in AFlags then begin
  5990. Result := Result + MessageFlags[mfSeen] + ' '; {Do not Localize}
  5991. end;
  5992. end;
  5993. function TIdIMAP4.DateToIMAPDateStr(const ADate: TDateTime): String;
  5994. var LDay, LMonth, LYear : Word;
  5995. begin
  5996. {Do not use the global settings from the system unit here because:
  5997. 1) It might not be thread safe
  5998. 2) Changing the settings could create problems for a user who's local date conventions
  5999. are diffrent than dd-mm-yyyy. Some people prefer mm-dd-yyy. Don't mess with a user's display settings.
  6000. 3) Using the display settings for dates may not always work as expected if a user
  6001. changes their settings at a time between whn you do it but before the date is formatted.
  6002. }
  6003. DecodeDate(ADate,LYear,LMonth,LDay);
  6004. Result := Format('%2.d',[LDay]) + '-' + UpperCase(monthnames[LMonth]) + '-' + Format('%4.d',[LYear]); {Do not Localize}
  6005. end;
  6006. procedure TIdIMAP4.StripCRLFs(ASourceStream, ADestStream: TStringStream);
  6007. var
  6008. LByte: Byte;
  6009. LNumSourceBytes: int64;
  6010. LBytesRead: int64;
  6011. begin
  6012. ASourceStream.Position := 0;
  6013. ADestStream.Size := 0;
  6014. LNumSourceBytes := ASourceStream.Size;
  6015. LBytesRead := 0;
  6016. while LBytesRead < LNumSourceBytes do begin
  6017. ASourceStream.ReadBuffer(LByte, 1);
  6018. //ASourceStream.Read(LByte);
  6019. if ((LByte <> 13) and (LByte <> 10)) then begin
  6020. ADestStream.WriteBuffer(LByte, 1);
  6021. //ADestStream.Write(LByte);
  6022. end;
  6023. Inc(LBytesRead);
  6024. end;
  6025. end;
  6026. procedure TIdIMAP4.StripCRLFs(var AText: string);
  6027. var
  6028. LPos: integer;
  6029. LLen: integer;
  6030. LTemp: string;
  6031. LDestPos: integer;
  6032. begin
  6033. //Optimised with the help of Guus Creuwels.
  6034. LPos := 1;
  6035. LLen := Length(AText);
  6036. SetLength(LTemp, LLen);
  6037. LDestPos := 1;
  6038. while LPos <= LLen do begin
  6039. if AText[LPos] = #13 then begin
  6040. //Don't GPF if this is the last char in the string...
  6041. if LPos < LLen then begin
  6042. if AText[LPos+1] = #10 then begin
  6043. Inc(LPos, 2);
  6044. end else begin
  6045. LTemp[LDestPos] := AText[LPos];
  6046. Inc(LPos);
  6047. Inc(LDestPos);
  6048. end;
  6049. end else begin
  6050. LTemp[LDestPos] := AText[LPos];
  6051. Inc(LPos);
  6052. Inc(LDestPos);
  6053. end;
  6054. end else begin
  6055. LTemp[LDestPos] := AText[LPos];
  6056. Inc(LPos);
  6057. Inc(LDestPos);
  6058. end;
  6059. end;
  6060. SetLength(LTemp, LDestPos - 1);
  6061. AText := LTemp;
  6062. end;
  6063. procedure TIdIMAP4.ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.'); {Do not Localize}
  6064. var
  6065. LMsgEnd: Boolean;
  6066. LActiveDecoder: TIdMessageDecoder;
  6067. LLine: string;
  6068. LCheckForOptionalImapFlags: Boolean;
  6069. LDelim: string;
  6070. {CC7: The following define SContentType is from IdMessageClient. It is defined here also
  6071. (with only local scope) because the one in IdMessageClient is defined locally
  6072. there also, so we cannot get at it.}
  6073. const
  6074. SContentType = 'Content-Type'; {do not localize}
  6075. function ProcessTextPart(ADecoder: TIdMessageDecoder): TIdMessageDecoder;
  6076. var
  6077. LDestStream: TStringStream;
  6078. LIdDestStream : TIdStreamVCL;
  6079. Li: integer;
  6080. begin
  6081. LDestStream := TStringStream.Create(''); {Do not Localize}
  6082. try
  6083. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  6084. //Result := ADecoder.ReadBody(LDestStream, LMsgEnd);
  6085. Result := ADecoder.ReadBody(LIdDestStream, LMsgEnd);
  6086. with TIdText.Create(AMsg.MessageParts) do begin
  6087. ContentType := ADecoder.Headers.Values[SContentType];
  6088. ContentID := ADecoder.Headers.Values['Content-ID']; {Do not Localize}
  6089. ContentLocation := ADecoder.Headers.Values['Content-Location']; {Do not Localize}
  6090. ExtraHeaders.NameValueSeparator := '='; {Do not Localize}
  6091. for Li := 0 to ADecoder.Headers.Count-1 do begin
  6092. if Headers.IndexOfName(ADecoder.Headers.Names[Li]) < 0 then begin
  6093. ExtraHeaders.Add(ADecoder.Headers.Strings[Li]);
  6094. end;
  6095. end;
  6096. ContentTransfer := ADecoder.Headers.Values['Content-Transfer-Encoding']; {Do not Localize}
  6097. {$IFDEF DOTNET}
  6098. Body.Text := Copy(LDestStream.DataString, 1, LDestStream.Size);
  6099. {$ELSE}
  6100. Body.Text := LDestStream.DataString;
  6101. {$ENDIF}
  6102. end;
  6103. ADecoder.Free;
  6104. finally
  6105. FreeAndNil(LDestStream);
  6106. end;
  6107. end;
  6108. function ProcessAttachment(ADecoder: TIdMessageDecoder): TIdMessageDecoder;
  6109. var
  6110. LDestStream: TStream;
  6111. Li: integer;
  6112. LAttachment: TIdAttachment;
  6113. LIdDestStream: TIdStreamVCL;
  6114. begin
  6115. Result := nil; // supress warnings
  6116. AMsg.DoCreateAttachment(ADecoder.Headers, LAttachment);
  6117. Assert(Assigned(LAttachment), 'Attachment must not be unassigned here!'); {Do not Localize}
  6118. with LAttachment do begin
  6119. try
  6120. LDestStream := PrepareTempStream;
  6121. try
  6122. LIdDestStream := TIdStreamVCL.Create(LDestStream);
  6123. //Result := ADecoder.ReadBody(LDestStream, LMsgEnd);
  6124. Result := ADecoder.ReadBody(LIdDestStream, LMsgEnd);
  6125. ContentType := ADecoder.Headers.Values[SContentType];
  6126. ContentTransfer := ADecoder.Headers.Values['Content-Transfer-Encoding']; {Do not Localize}
  6127. // dsiders 2001.12.01
  6128. ContentDisposition := ADecoder.Headers.Values['Content-Disposition']; {Do not Localize}
  6129. ContentID := ADecoder.Headers.Values['Content-ID']; {Do not Localize}
  6130. ContentLocation := ADecoder.Headers.Values['Content-Location']; {Do not Localize}
  6131. Filename := ADecoder.Filename;
  6132. ExtraHeaders.NameValueSeparator := '='; {Do not Localize}
  6133. for Li := 0 to ADecoder.Headers.Count-1 do begin
  6134. if Headers.IndexOfName(ADecoder.Headers.Names[Li]) < 0 then begin
  6135. ExtraHeaders.Add(ADecoder.Headers.Strings[Li]);
  6136. end;
  6137. end;
  6138. ADecoder.Free;
  6139. finally
  6140. FinishTempStream;
  6141. end;
  6142. except
  6143. //this should also remove the Item from the TCollection.
  6144. //Note that Delete does not exist in the TCollection.
  6145. AMsg.MessageParts[Index].Free;
  6146. Free;
  6147. end;
  6148. end;
  6149. end;
  6150. Begin
  6151. {CC3: If IMAP calls this ReceiveBody, it prepends IMAP to delim, e.g. 'IMAP)',
  6152. to flag that this routine should expect IMAP FLAGS entries.}
  6153. LCheckForOptionalImapFlags := False; {CC3: IMAP hack inserted lines start here...}
  6154. LDelim := ADelim;
  6155. if Copy(ADelim, 1, 4) = 'IMAP' then begin {do not localize}
  6156. LCheckForOptionalImapFlags := True;
  6157. LDelim := Copy(ADelim, 5, MaxInt);
  6158. end; {CC3: ...IMAP hack inserted lines end here}
  6159. LMsgEnd := False;
  6160. if AMsg.NoDecode then begin
  6161. IOHandler.Capture(AMsg.Body, ADelim);
  6162. end else begin
  6163. BeginWork(wmRead);
  6164. try
  6165. LActiveDecoder := nil;
  6166. repeat
  6167. LLine := IOHandler.ReadLn;
  6168. {CC3: Check for optional flags before delimiter in the case of IMAP...}
  6169. if LLine = LDelim then begin {CC3: IMAP hack ADelim -> LDelim}
  6170. Break;
  6171. end else begin {CC3: IMAP hack inserted lines start here...}
  6172. if LCheckForOptionalImapFlags = True then begin
  6173. if ( (Copy(LLine, 1, 9) = ' FLAGS (\') {do not localize}
  6174. and (Length(LLine) > Length(LDelim))
  6175. and (LDelim = Copy(LLine, Length(LLine)-Length(LDelim)+1, Length(LDelim))) ) then begin
  6176. Break;
  6177. end;
  6178. end; {CC3: ...IMAP hack inserted lines end here}
  6179. end;
  6180. if LActiveDecoder = nil then begin
  6181. LActiveDecoder := TIdMessageDecoderList.CheckForStart(AMsg, LLine);
  6182. end;
  6183. if LActiveDecoder = nil then begin
  6184. {CC9: Per RFC821, the sender is required to add a prefixed '.' to any
  6185. line in an email that starts with '.' and the receiver is
  6186. required to strip it off. This ensures that the end-of-message
  6187. line '.' cannot appear in the message body.}
  6188. if ((Length (LLine) > 0) and (LLine[1] = '.')) then begin {Do not Localize}
  6189. Delete(LLine,1,1);
  6190. end;
  6191. AMsg.Body.Add(LLine);
  6192. end else begin
  6193. while LActiveDecoder <> nil do begin
  6194. LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
  6195. LActiveDecoder.ReadHeader;
  6196. case LActiveDecoder.PartType of
  6197. mcptUnknown:
  6198. begin
  6199. raise EIdException.Create(RSMsgClientUnkownMessagePartType);
  6200. end;
  6201. mcptText:
  6202. begin
  6203. LActiveDecoder := ProcessTextPart(LActiveDecoder);
  6204. end;
  6205. mcptAttachment:
  6206. begin
  6207. LActiveDecoder := ProcessAttachment(LActiveDecoder);
  6208. end;
  6209. end;
  6210. end;
  6211. end;
  6212. until LMsgEnd;
  6213. finally
  6214. EndWork(wmRead);
  6215. end;
  6216. end;
  6217. end;
  6218. {######### Following was temporarily but unsuccessfully in IdReplyIMAP4 #############}
  6219. {########### Following only used by CONNECT? ###############}
  6220. function TIdIMAP4.GetResponse: string;
  6221. {CC: The purpose of this is to keep reading & accumulating lines until we hit
  6222. a line that has a valid response (that terminates the reading). We call
  6223. "FLastCmdResult.FormattedReply := LResponse;" to parse out the response we
  6224. received.
  6225. The response sequences we need to deal with are:
  6226. 1) Many commands just give a simple result to the command issued:
  6227. C41 OK Completed
  6228. 2) Some commands give you data first, then the result:
  6229. * LIST (\UnMarked) "/" INBOX
  6230. * LIST (\UnMarked) "/" Junk
  6231. * LIST (\UnMarked) "/" Junk/Subbox1
  6232. C42 OK Completed
  6233. 3) Some responses have a result but * instead of a command number (like C42):
  6234. * OK CommuniGate Pro IMAP Server 3.5.7 ready
  6235. 4) Some have neither a * nor command number, but start with a result:
  6236. + Send the additional command text
  6237. or:
  6238. BAD Bad parameter
  6239. Because you may get data first, which you need to skip, you need to
  6240. accept all the above possibilities.
  6241. We MUST stop when we find a valid response code, like OK.
  6242. }
  6243. label
  6244. GoAgain;
  6245. var LLine: String;
  6246. LResponse: TIdStringList;
  6247. LWord: string;
  6248. LPos: integer;
  6249. LBuf: string;
  6250. begin
  6251. LResponse := TIdStringList.Create;
  6252. Result := ''; {Do not Localize}
  6253. try
  6254. GoAgain:
  6255. LLine := ReadLnWait;
  6256. if LLine = '' then begin {Do not Localize}
  6257. goto GoAgain; {Ignore empty lines}
  6258. end;
  6259. {It is not an empty line, add it to our list of stuff received (it is
  6260. not our job to interpret it)}
  6261. LResponse.Add(LLine);
  6262. {See if the last LLine contained a response code like OK or BAD.}
  6263. LPos := Pos(' ', LLine); {Do not Localize}
  6264. if LPos <> 0 then begin
  6265. {There are at least two words on this line...}
  6266. LWord := Trim(Copy(LLine, 1, LPos-1));
  6267. LBuf := Trim(Copy(LLine, LPos+1, MaxInt)); {The rest of the line, without the 1st word}
  6268. end else begin
  6269. {No space, so this line is a single word. A bit weird, but it
  6270. could be just an OK...}
  6271. LWord := LLine; {A bit pedantic, but emphasises we have a word, not a line}
  6272. LBuf := ''; {Do not Localize}
  6273. end;
  6274. LPos := PosInStrArray(LWord,VALID_TAGGEDREPLIES); {Do not Localize}
  6275. if LPos > -1 then begin
  6276. {We got a valid response code as the first word...}
  6277. Result := LWord;
  6278. FLastCmdResult.FormattedReply := LResponse;
  6279. Exit;
  6280. end;
  6281. if LBuf = '' then begin {Do not Localize}
  6282. goto GoAgain; {We hit a line with just one word which is not a valid IMAP response}
  6283. end;
  6284. {In all other cases, any valid response should be the second word...}
  6285. LPos := Pos(' ', LBuf); {Do not Localize}
  6286. if LPos <> 0 then begin
  6287. {There are at least three words on this line...}
  6288. LWord := Trim(Copy(LBuf, 1, LPos-1));
  6289. LBuf := Trim(Copy(LBuf, LPos+1, MaxInt)); {The rest of the line, without the 1st word}
  6290. end else begin
  6291. {No space, so this line is two single words.}
  6292. LWord := LLine; {A bit pedantic, but emphasises we have a word, not a line}
  6293. LBuf := ''; {Do not Localize}
  6294. end;
  6295. LPos := PosInStrArray(LWord,VALID_TAGGEDREPLIES); {Do not Localize}
  6296. if LPos > -1 then begin
  6297. {We got a valid response code as the second word...}
  6298. Result := LWord;
  6299. FLastCmdResult.FormattedReply := LResponse;
  6300. Exit;
  6301. end;
  6302. goto GoAgain; {No response code here, get another line}
  6303. finally
  6304. {$IFDEF DOTNET}
  6305. LResponse.Free;
  6306. {$ELSE}
  6307. FreeAndNil (LResponse);
  6308. {$ENDIF}
  6309. end;
  6310. end;
  6311. end.