Download fixed idemailaddress.pas

  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 13822: IdEMailAddress.pas
  11. {
  12. { Rev 1.13 10/26/2004 9:09:36 PM JPMugaas
  13. { Updated references.
  14. }
  15. {
  16. { Rev 1.12 24/10/2004 21:25:18 ANeillans
  17. { Modifications to allow Username and Domain parts to be set.
  18. }
  19. {
  20. { Rev 1.11 24.08.2004 17:29:30 Andreas Hausladen
  21. { Fixed GetEMailAddresses
  22. { Lots of simple but effective optimizations
  23. }
  24. {
  25. { Rev 1.10 09/08/2004 08:17:08 ANeillans
  26. { Rename username property to user
  27. }
  28. {
  29. { Rev 1.9 08/08/2004 20:58:02 ANeillans
  30. { Added support for Username extraction.
  31. }
  32. {
  33. { Rev 1.8 23/04/2004 20:34:36 CCostelloe
  34. { Clarified a question in the code as to why a code path ended there
  35. }
  36. {
  37. { Rev 1.7 3/6/2004 5:45:00 PM JPMugaas
  38. { Fixed problem obtaining the Text property for an E-Mail address with no
  39. { domain.
  40. }
  41. {
  42. { Rev 1.6 2004.02.03 5:45:08 PM czhower
  43. { Name changes
  44. }
  45. {
  46. { Rev 1.5 24/01/2004 19:12:10 CCostelloe
  47. { Cleaned up warnings
  48. }
  49. {
  50. { Rev 1.4 10/12/2003 7:51:50 PM BGooijen
  51. { Fixed Range Check Error
  52. }
  53. {
  54. { Rev 1.3 10/8/2003 9:50:24 PM GGrieve
  55. { use IdDelete
  56. }
  57. {
  58. { Rev 1.2 6/10/2003 5:48:50 PM SGrobety
  59. { DotNet updates
  60. }
  61. {
  62. { Rev 1.1 5/18/2003 02:30:36 PM JPMugaas
  63. { Added some backdoors for the TIdDirectSMTP processing.
  64. }
  65. {
  66. { Rev 1.0 11/14/2002 02:19:44 PM JPMugaas
  67. }
  68. unit IdEMailAddress;
  69.  
  70. {
  71. ToDo: look into alterations required for TIdEMailAddressItem.GetText.
  72. }
  73. {
  74. 2001-Aug-30 - Jim Gunkel
  75. - Fixed bugs that would occur with group names containing spaces (box test 19)
  76. and content being located after the email address (box test 33)
  77. 2001-Jul-11 - Allen O'Neill
  78. - Added hack to not allow recipient entries being added that are blank
  79. 2001-Jul-11 - Allen O'Neill
  80. - Added hack to accomodate a PERIOD (#46) in an email address - this whole area needs to be looked at.
  81. 2001-Feb-03 - Peter Mee
  82. - Overhauled TIdEMailAddressItem.GetText to support non-standard textual
  83. elements.
  84. 2001-Jan-29 - Peter Mee
  85. - Overhauled TIdEMailAddressList.SetEMailAddresses to support comments
  86. and escaped characters and to ignore groups.
  87. 2001-Jan-28 - Peter Mee
  88. - Overhauled TIdEMailAddressItem.SetText to support comments and escaped
  89. characters.
  90. 2000-Jun-10 - J. Peter Mugaas
  91. - started this unit to facilitate some Indy work including the
  92. TIdEMailAddressItem and TIdEMailAddressList classes
  93. - The GetText and SetText were originally the ToArpa and FromArpa functions in
  94. the TIdMessage component}
  95.  
  96.  
  97. interface
  98.  
  99. uses
  100. Classes,
  101. IdException,
  102. IdTStrings;
  103.  
  104. type
  105. EIdEmailParseError = class(EIdException);
  106.  
  107. TIdEMailAddressItem = class(TCollectionItem)
  108. protected
  109. FAddress: string;
  110. FName: string;
  111. function GetText: string;
  112. procedure SetText(AText: string);
  113. function ConvertAddress: string;
  114. function GetDomain: string;
  115. procedure SetDomain(const ADomain: string);
  116. function GetUsername: string;
  117. procedure SetUsername(const AUsername: string);
  118. public
  119. procedure Assign(Source: TPersistent); override;
  120. published
  121. {This is the E-Mail address itself }
  122. property Address: string read FAddress write FAddress;
  123. {This is the person's name}{Do not Localize}
  124. property Name: string read FName write FName;
  125. {This is the combined person's name and E-Mail address}{Do not Localize}
  126. property Text: string read GetText write SetText;
  127. {Extracted domain for some types of E-Mail processing}
  128. property Domain: string read GetDomain write SetDomain;
  129. property User: string read GetUsername write SetUsername;
  130. end;
  131.  
  132. TIdEMailAddressList = class(TOwnedCollection)
  133. protected
  134. function GetItem(Index: Integer): TIdEMailAddressItem;
  135. procedure SetItem(Index: Integer; const Value: TIdEMailAddressItem);
  136. function GetEMailAddresses: string;
  137. procedure SetEMailAddresses(AList: string);
  138. public
  139. constructor Create(AOwner: TPersistent); reintroduce;
  140.  
  141. {This returns formatted list of formated
  142. addresses including the names from the collection }
  143. procedure FillTStrings(AStrings: TIdStrings);
  144. function Add: TIdEMailAddressItem;
  145. //get all of the domains in the list so we can process those individually with
  146. //TIdDirectSMTP
  147. procedure GetDomains(AStrings: TIdStrings);
  148. {Sort by domains for making it easier to process E-Mails directly in
  149. TIdDirectSMTP}
  150. procedure SortByDomain;
  151. //Get all of the E-Mail addresses for a particular domain so we can
  152. //send E-Mail to recipients at one domain with only one connection for
  153. //speed with TIdDirectSMTP.
  154. procedure AddressesByDomain(AList: TIdEMailAddressList; const ADomain: string);
  155. property Items[Index: Integer]: TIdEMailAddressItem read GetItem write SetItem; default;
  156. {This is a comma separated list of formated
  157. addresses including the names from the collection }
  158. property EMailAddresses: string read GetEMailAddresses write SetEMailAddresses;
  159. end;
  160.  
  161. implementation
  162.  
  163. uses
  164. SysUtils,
  165. IdGlobal, IdGlobalProtocols, IdExceptionCore, IdResourceStringsProtocols;
  166.  
  167. const
  168. // This is actually the ATEXT without the '"' and space characters... {Do not Localize}
  169. IETF_ATEXT: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' {Do not Localize}
  170. + '1234567890!#$%&''*+-/=?_`{}|~'; {Do not Localize}
  171. // ATEXT without the '"' {Do not Localize}
  172. IETF_ATEXT_SPACE: string = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' {Do not Localize}
  173. + '1234567890!#$%&''*+-/=?_`{}|~ '; {Do not Localize}
  174. IETF_QUOTABLE: string = '\"'; {Do not Localize}
  175.  
  176. // Three functions for easier manipulating of strings.
  177. // Don't know of any system functions to perform these actions. {Do not Localize}
  178. // If there aren't & someone can find an optimised way of performing {Do not Localize}
  179. // then please implement...
  180.  
  181. function FindFirstOf(const AFind, AText: string): Integer;
  182. var
  183. nCount, nPos: Integer;
  184. begin
  185. Result := 0;
  186. for nCount := 1 to Length(AFind) do begin
  187. nPos := IndyPos(AFind[nCount], AText);
  188. if nPos > 0 then begin
  189. if Result = 0 then begin
  190. Result := nPos;
  191. end else if Result > nPos then begin
  192. Result := nPos;
  193. end;
  194. end;
  195. end;
  196. end;
  197.  
  198. function FindFirstNotOf(const AFind, AText: string): Integer;
  199. var
  200. i: Integer;
  201. begin
  202. Result := 0;
  203. if AFind = '' then
  204. begin
  205. Result := 1;
  206. Exit;
  207. end;
  208.  
  209. if AText = '' then
  210. begin
  211. Exit;
  212. end;
  213.  
  214. for i := 1 to Length(AText) do
  215. begin
  216. if IndyPos(AText[i], AFind) = 0 then
  217. begin
  218. Result := i;
  219. Exit;
  220. end;
  221. end;
  222. end;
  223.  
  224. function TrimAllOf(const ATrim, AText: string): string;
  225. var
  226. Len: Integer;
  227. begin
  228. Result := AText;
  229. Len := Length(Result);
  230. while Len > 0 do
  231. begin
  232. if Pos(Result[1], ATrim) > 0 then
  233. begin
  234. Delete(Result, 1, 1);
  235. Dec(Len);
  236. end else Break;
  237. end;
  238. while Len > 0 do begin
  239. if Pos(Result[Len], ATrim) > 0 then
  240. begin
  241. Delete(Result, Len, 1);
  242. Dec(Len);
  243. end else Break;
  244. end;
  245. end;
  246.  
  247. { TIdEMailAddressItem }
  248.  
  249. procedure TIdEMailAddressItem.Assign(Source: TPersistent);
  250. var Addr: TIdEMailAddressItem;
  251. begin
  252. if ClassType <> Source.ClassType then
  253. begin
  254. inherited
  255. end
  256. else
  257. begin
  258. Addr := TIdEMailAddressItem(Source);
  259. Address := Addr.Address;
  260. Name := Addr.Name;
  261. end;
  262. end;
  263.  
  264. function TIdEMailAddressItem.ConvertAddress: string;
  265. var
  266. i: Integer;
  267. domainPart, tempAddress, localPart: string;
  268. begin
  269. if FAddress = '' then
  270. begin
  271. if FName <> '' then
  272. begin
  273. Result := '<>'; {Do not Localize}
  274. end else
  275. begin
  276. Result := ''; {Do not Localize}
  277. end;
  278. Exit;
  279. end;
  280.  
  281. // First work backwards to the @ sign.
  282. tempAddress := FAddress;
  283. domainPart := '';
  284. for i := Length(FAddress) downto 1 do
  285. begin
  286. if FAddress[i] = '@' then {Do not Localize}
  287. begin
  288. domainPart := Copy(FAddress, i, MaxInt);
  289. tempAddress := Copy(FAddress, 1, i - 1);
  290. Break;
  291. end;
  292. end;
  293.  
  294. i := FindFirstNotOf(IETF_ATEXT, tempAddress);
  295. if (i = 0) or (Copy(tempAddress, i, 1) = #46) then //hack to accomodate periods in emailaddress
  296. // if i = 0 then
  297. begin
  298. if FName <> '' then
  299. begin
  300. Result := '<' + tempAddress + domainPart + '>'; {Do not Localize}
  301. end else
  302. begin
  303. Result := tempAddress + domainPart;
  304. end;
  305. end else
  306. begin
  307. localPart := '"'; {Do not Localize}
  308. while i > 0 do
  309. begin
  310. localPart := localPart + Copy(tempAddress, 1, i - 1);
  311. if IndyPos(tempAddress[i], IETF_QUOTABLE) > 0 then
  312. begin
  313. localPart := localPart + '\'; {Do not Localize}
  314. end;
  315. localPart := localPart + tempAddress[i];
  316. IdDelete(tempAddress, 1, i);
  317. i := FindFirstNotOf(IETF_ATEXT, tempAddress);
  318. end;
  319. Result := '<' + localPart + tempAddress + '"' + domainPart + '>'; {Do not Localize}
  320. end;
  321. end;
  322.  
  323. function TIdEMailAddressItem.GetDomain: string;
  324. var i: Integer;
  325. begin
  326. Result := '';
  327. for i := Length(FAddress) downto 1 do
  328. begin
  329. if FAddress[i] = '@' then {Do not Localize}
  330. begin
  331. Result := Copy(FAddress, i + 1, MaxInt);
  332. Break;
  333. end;
  334. end;
  335. end;
  336.  
  337. procedure TIdEMailAddressItem.SetDomain(const ADomain: string);
  338. var
  339. Result: string;
  340. begin
  341. Result := FAddress;
  342. Delete(Result, Pos('@', Result) - 1, Length(Result));
  343. Result := Result + '@' + ADomain;
  344. FAddress := Result;
  345. end;
  346.  
  347. function TIdEMailAddressItem.GetUsername: string;
  348. var i: Integer;
  349. begin
  350. Result := '';
  351. for i := Length(FAddress) downto 1 do
  352. begin
  353. if FAddress[i] = '@' then {Do not Localize}
  354. begin
  355. Result := Copy(FAddress, 1, i - 1);
  356. Break;
  357. end;
  358. end;
  359. end;
  360.  
  361. procedure TIdEMailAddressItem.SetUsername(const AUsername: string);
  362. var
  363. Result: string;
  364. begin
  365. Result := FAddress;
  366. Delete(Result, 1, Pos('@', Result) + 1);
  367. Result := AUsername + '@' + Result;
  368. FAddress := Result;
  369. end;
  370.  
  371. function TIdEMailAddressItem.GetText: string;
  372. var
  373. i: Integer;
  374. tempName, resName: string;
  375. begin
  376. if (FName <> '') and (UpperCase(FAddress) <> FName) then
  377. begin
  378. i := FindFirstNotOf(IETF_ATEXT_SPACE, FName);
  379. if i > 0 then
  380. begin
  381. // Need to quote the FName.
  382. resName := '"' + Copy(FName, 1, i - 1); {Do not Localize}
  383. if IndyPos(FName[i], IETF_QUOTABLE) > 0 then
  384. begin
  385. resName := resName + '\'; {Do not Localize}
  386. end;
  387. resName := resName + FName[i];
  388.  
  389. tempName := Copy(FName, i + 1, MaxInt);
  390. while tempName <> '' do
  391. begin
  392. i := FindFirstNotOf(IETF_ATEXT_SPACE, tempName);
  393. if i = 0 then
  394. begin
  395. Result := resName + tempName + '" ' + ConvertAddress; {Do not Localize}
  396. Exit;
  397. end;
  398. resName := resName + Copy(tempName, 1, i - 1);
  399. if IndyPos(tempName[i], IETF_QUOTABLE) > 0 then
  400. begin
  401. resName := resName + '\'; {Do not Localize}
  402. end;
  403. resName := resName + tempName[i];
  404. IdDelete(tempName, 1, i);
  405. end;
  406. Result := resName + '" ' + ConvertAddress; {Do not Localize}
  407. end else
  408. begin
  409. Result := FName + ' ' + ConvertAddress; {Do not Localize}
  410. end;
  411. end // if
  412. else
  413. begin
  414. Result := ConvertAddress;
  415. end; // else .. if
  416. end;
  417.  
  418. procedure TIdEMailAddressItem.SetText(AText: string);
  419. var
  420. nFirst,
  421. nBracketCount: Integer;
  422. bInAddress,
  423. bAddressInLT,
  424. bAfterAt,
  425. bInQuote: Boolean;
  426. begin
  427. FAddress := ''; {Do not Localize}
  428. FName := ''; {Do not Localize}
  429.  
  430. AText := Trim(AText);
  431. if AText = '' then
  432. Exit;
  433.  
  434. // Find the first known character type.
  435. nFirst := FindFirstOf('("< @' + TAB, AText); {Do not Localize}
  436. if nFirst <> 0 then
  437. begin
  438. nBracketCount := 0;
  439. bInAddress := False;
  440. bAddressInLT := False;
  441. bInQuote := False;
  442. bAfterAt := False;
  443. repeat
  444. case AText[nFirst] of
  445. ' ', TAB: {Do not Localize}
  446. begin
  447. if nFirst = 1 then
  448. begin
  449. Delete(AText, 1, 1);
  450. end else
  451. begin
  452. // Only valid if in a name not contained in quotes - keep the space.
  453. if bAfterAt then begin
  454. FAddress := FAddress + Trim(Copy(AText, 1, nFirst - 1));
  455. end else begin
  456. FName := FName + Copy(AText, 1, nFirst);
  457. end;
  458. IdDelete(AText, 1, nFirst);
  459. end;
  460. end;
  461. '(': {Do not Localize}
  462. begin
  463. Inc(nBracketCount);
  464. if (nFirst > 1) then
  465. begin
  466. // There's at least one character to the name {Do not Localize}
  467. if bInAddress then
  468. begin
  469. FAddress := FAddress + Trim(Copy(AText, 1, nFirst - 1));
  470. end else
  471. begin
  472. if nBracketCount = 1 then
  473. begin
  474. FName := FName + Copy(AText, 1, nFirst - 1);
  475. end;
  476. end;
  477. IdDelete(AText, 1, nFirst);
  478. end else
  479. begin
  480. Delete(AText, 1, 1);
  481. end;
  482. end;
  483. ')': {Do not Localize}
  484. begin
  485. Dec(nBracketCount);
  486. IdDelete(AText, 1, nFirst);
  487. end;
  488. '"': {Do not Localize}
  489. begin
  490. if bInQuote then
  491. begin
  492. if bAddressInLT then
  493. begin
  494. FAddress := FAddress + Trim(Copy(AText, 1, nFirst - 1));
  495. end else
  496. begin
  497. FName := FName + Trim(Copy(AText, 1, nFirst - 1));
  498. end;
  499. IdDelete(AText, 1, nFirst);
  500. bInQuote := False;
  501. end else
  502. begin
  503. bInQuote := True;
  504. Delete(AText, 1, 1);
  505. end;
  506. end;
  507. '<': {Do not Localize}
  508. begin
  509. if nFirst > 1 then
  510. begin
  511. FName := FName + Copy(AText, 1, nFirst - 1);
  512. end;
  513. FName := TrimAllOf(' ' + TAB, Trim(FName)); {Do not Localize}
  514. bAddressInLT := True;
  515. bInAddress := True;
  516. Delete(AText, 1, nFirst);
  517. end;
  518. '>': {Do not Localize}
  519. begin
  520. // Only searched for if the address starts with '<' {Do not Localize}
  521. bInAddress := False;
  522. bAfterAt := False;
  523. FAddress := FAddress +
  524. TrimAllOf(' ' + TAB, Trim(Copy(AText, 1, nFirst - 1))); {Do not Localize}
  525. IdDelete(AText, 1, nFirst);
  526. end;
  527. '@': {Do not Localize}
  528. begin
  529. bAfterAt := True;
  530. if bInAddress then
  531. begin
  532. FAddress := FAddress + Copy(AText, 1, nFirst);
  533. IdDelete(AText, 1, nFirst);
  534. end else
  535. begin
  536. if bAddressInLT then
  537. begin
  538. // Strange use. For now raise an exception until a real-world
  539. // example can be found.
  540. // Basically, it's formatted as follows: {Do not Localize}
  541. // <someguy@domain.example> some-text @ some-text
  542. // or:
  543. // some-text <someguy@domain.example> some-text @ some-text
  544. // where some text may be blank.
  545. //CC: Note you used to arrive here if the From header in an email
  546. //included more than one address (which was subsequently changed)
  547. //because our code did not parse the From header for multiple
  548. //addresses. That may have been the reason for this code.
  549. // raise EIdEmailParseError.Create(RSEMailSymbolOutsideAddress);
  550. fName := fName + AText;
  551. Exit;
  552. end else
  553. begin
  554. // If at this point, we're either supporting an e-mail address {Do not Localize}
  555. // on it's own, or the old-style valid format: {Do not Localize}
  556. // "Name" name@domain.example
  557. bInAddress := True;
  558. FAddress := FAddress + Copy(AText, 1, nFirst);
  559. IdDelete(AText, 1, nFirst);
  560. end;
  561. end;
  562. end;
  563. '.': {Do not Localize}
  564. begin
  565. // Must now be a part of the domain part of the address.
  566. if bAddressInLT then
  567. begin
  568. // Whitespace is possible around the parts of the domain.
  569. FAddress := FAddress +
  570. TrimAllOf(' ' + TAB, Trim(Copy(AText, 1, nFirst - 1))) + '.'; {Do not Localize}
  571. AText := TrimLeft(Copy(AText, nFirst + 1, MaxInt));
  572. end else
  573. begin
  574. // No whitespace is allowed if no wrapping <> characters.
  575. FAddress := FAddress + Copy(AText, 1, nFirst);
  576. IdDelete(AText, 1, nFirst);
  577. end;
  578. end;
  579. '\': {Do not Localize}
  580. begin
  581. // This will only be discovered in a bracketted or quoted section.
  582. // It's an escape character indicating the next cahracter is {Do not Localize}
  583. // a literal.
  584. if bInQuote then
  585. begin
  586. // Need to retain the second character
  587. if bInAddress then
  588. begin
  589. FAddress := FAddress + Copy(AText, 1, nFirst - 1);
  590. FAddress := FAddress + AText[nFirst + 1];
  591. end else
  592. begin
  593. FName := FName + Copy(AText, 1, nFirst - 1);
  594. FName := FName + AText[nFirst + 1];
  595. end;
  596. end;
  597. IdDelete(AText, 1, nFirst + 1);
  598. end;
  599. end;
  600.  
  601.  
  602. // Check for bracketted sections first: ("<>" <> "" <"">) - all is ignored
  603. if nBracketCount > 0 then
  604. begin
  605. // Inside a bracket, only three charatcers are special.
  606. // '(' Opens a nested bracket: (One (Two (Three ))) {Do not Localize}
  607. // ')' Closes a bracket {Do not Localize}
  608. // '/' Escape character: (One /) /( // (Two /) )) {Do not Localize}
  609. nFirst := FindFirstOf('()\', AText); {Do not Localize}
  610.  
  611. // Check if in quote before address: <"My Name"@domain.example> is valid
  612. end else if bInQuote then
  613. begin
  614. // Inside quotes, only the end quote and escape character are special.
  615. nFirst := FindFirstOf('"\', AText); {Do not Localize}
  616.  
  617. // Check if after the @ of the address: domain.example>
  618. end else if bAfterAt then
  619. begin
  620. if bAddressInLT then
  621. begin
  622. // If the address is enclosed, then only the '(', '.' & '>' need be {Do not Localize}
  623. // looked for, trimming all content when found: domain . example >
  624. nFirst := FindFirstOf('.>(', AText); {Do not Localize}
  625. end else
  626. begin
  627. nFirst := FindFirstOf('.( ', AText); {Do not Localize}
  628. end;
  629.  
  630. // Check if in address: <name@domain.example>
  631. end else if bInAddress then
  632. begin
  633. nFirst := FindFirstOf('"(@>', AText); {Do not Localize}
  634.  
  635. // Not in anything - check for opening charactere
  636. end else
  637. begin
  638. // Outside brackets
  639. nFirst := FindFirstOf('("< @' + TAB, AText); {Do not Localize}
  640. end;
  641. until nFirst = 0;
  642. if bInAddress and not bAddressInLT then
  643. begin
  644. FAddress := FAddress + TrimAllOf(' ' + TAB, Trim(AText)); {Do not Localize}
  645. end;
  646. end else
  647. begin
  648. // No special characters, so assume a simple address
  649. FAddress := AText;
  650. end;
  651. end;
  652.  
  653.  
  654.  
  655. { TIdEMailAddressList }
  656.  
  657. function TIdEMailAddressList.Add: TIdEMailAddressItem;
  658. begin
  659. Result := TIdEMailAddressItem(inherited Add);
  660. end;
  661.  
  662. constructor TIdEMailAddressList.Create(AOwner: TPersistent);
  663. begin
  664. inherited Create(AOwner, TIdEMailAddressItem);
  665. end;
  666.  
  667. procedure TIdEMailAddressList.FillTStrings(AStrings: TIdStrings);
  668. var
  669. idx: Integer;
  670. begin
  671. for idx := 0 to Count - 1 do
  672. begin
  673. AStrings.Add(GetItem(idx).Text);
  674. end;
  675. end;
  676.  
  677. function TIdEMailAddressList.GetItem(Index: Integer): TIdEMailAddressItem;
  678. begin
  679. Result := TIdEMailAddressItem(inherited Items[Index]);
  680. end;
  681.  
  682. function TIdEMailAddressList.GetEMailAddresses: string;
  683. var
  684. idx: Integer;
  685. begin
  686. Result := ''; {Do not Localize}
  687. for idx := 0 to Count - 1 do
  688. begin
  689. if Result = '' then
  690. Result := GetItem(idx).Text
  691. else
  692. Result := Result + ', ' + GetItem(idx).Text; {Do not Localize}
  693. end;
  694. end;
  695.  
  696. procedure TIdEMailAddressList.SetItem(Index: Integer;
  697. const Value: TIdEMailAddressItem);
  698. begin
  699. inherited SetItem(Index, Value);
  700. end;
  701.  
  702. procedure TIdEMailAddressList.SetEMailAddresses(AList: string);
  703. var
  704. EMail: TIdEMailAddressItem;
  705. iStart: Integer;
  706. sTemp: string;
  707. nInBracket: Integer;
  708. bInQuote: Boolean;
  709. begin
  710. Clear;
  711.  
  712. if (Trim(AList) = '') then Exit; {Do not Localize}
  713.  
  714. iStart := FindFirstOf(':;(", ' + TAB, AList); {Do not Localize}
  715. if iStart = 0 then begin
  716. EMail := Add;
  717. EMail.Text := TrimLeft(AList);
  718. end else begin
  719. sTemp := ''; {Do not Localize}
  720. nInBracket := 0;
  721. bInQuote := False;
  722. repeat
  723. case AList[iStart] of
  724. ' ', TAB: begin {Do not Localize}
  725. if iStart = 1 then begin
  726. sTemp := sTemp + AList[iStart];
  727. IdDelete(AList, 1, 1);
  728. end else begin
  729. sTemp := sTemp + Copy(AList, 1, iStart);
  730. IdDelete(AList, 1, iStart);
  731. end;
  732. end;
  733. ':': {Do not Localize}
  734. begin
  735. // The start of a group - ignore the lot.
  736. IdDelete(AList, 1, iStart);
  737. sTemp := ''; {Do not Localize}
  738. end;
  739. ';': {Do not Localize}
  740. begin
  741. // End of a group. If we have something (groups can be empty),
  742. // then process it.
  743. sTemp := sTemp + Copy(AList, 1, iStart - 1);
  744. if Trim(sTemp) <> '' then begin
  745. EMail := Add;
  746. EMail.Text := TrimLeft(sTemp);
  747. sTemp := ''; {Do not Localize}
  748. end;
  749. // Now simply remove the end of the group.
  750. IdDelete(AList, 1, iStart);
  751. end;
  752. '(': begin {Do not Localize}
  753. Inc(nInBracket);
  754. sTemp := sTemp + Copy(AList, 1, iStart);
  755. IdDelete(AList, 1, iStart);
  756. end;
  757. ')': begin {Do not Localize}
  758. Dec(nInBracket);
  759. sTemp := sTemp + Copy(AList, 1, iStart);
  760. IdDelete(AList, 1, iStart);
  761. end;
  762. '"': begin {Do not Localize}
  763. sTemp := sTemp + Copy(AList, 1, iStart);
  764. IdDelete(AList, 1, iStart);
  765. bInQuote := not bInQuote;
  766. end;
  767. ',': begin {Do not Localize}
  768. sTemp := sTemp + Copy(AList, 1, iStart - 1);
  769. EMail := Add;
  770. EMail.Text := sTemp;
  771. // added - Allen .. saves blank entries being added
  772. if (Trim(Email.Text) = '') or (Trim(Email.Text) = '<>') then {Do not Localize}
  773. begin
  774. FreeAndNil(Email);
  775. end;
  776. sTemp := ''; {Do not Localize}
  777. IdDelete(AList, 1, iStart);
  778. end;
  779. '\': begin {Do not Localize}
  780. // Escape character - simply copy this char and the next to the buffer.
  781. sTemp := sTemp + Copy(AList, 1, iStart + 1);
  782. IdDelete(AList, 1, iStart + 1);
  783. end;
  784. end;
  785.  
  786. if nInBracket > 0 then begin
  787. iStart := FindFirstOf('(\)', AList); {Do not Localize}
  788. end else if bInQuote then begin
  789. iStart := FindFirstOf('"\', AList); {Do not Localize}
  790. end else begin
  791. iStart := FindFirstOf(':;(", ' + TAB, AList); {Do not Localize}
  792. end;
  793. until iStart = 0;
  794.  
  795. // Clean up the content in sTemp
  796. if (Trim(sTemp) <> '') or (Trim(AList) <> '') then begin
  797. sTemp := sTemp + AList;
  798. EMail := Add;
  799. EMail.Text := TrimLeft(sTemp);
  800. // added - Allen .. saves blank entries being added
  801. if (Trim(Email.Text) = '') or (Trim(Email.Text) = '<>') then {Do not Localize}
  802. begin
  803. FreeAndNil(Email);
  804. end;
  805. end;
  806. end;
  807. end;
  808.  
  809. procedure TIdEMailAddressList.SortByDomain;
  810. var
  811. i, j: Integer;
  812. LTemp: string;
  813. begin
  814. for i := Count - 1 downto 0 do
  815. begin
  816. for j := 0 to Count - 2 do
  817. begin
  818. if IndyCompareStr(Items[J].Domain, Items[J + 1].Domain) > 0 then begin
  819. LTemp := Items[j].Text;
  820.  
  821. Items[j].Text := Items[j + 1].Text;
  822. Items[j + 1].Text := LTemp;
  823. end;
  824. end;
  825. end;
  826. end;
  827.  
  828. procedure TIdEMailAddressList.GetDomains(AStrings: TIdStrings);
  829. var
  830. i: Integer;
  831. LCurDom: string;
  832. begin
  833. if Assigned(AStrings) then
  834. begin
  835. AStrings.Clear;
  836. for i := 0 to Count - 1 do
  837. begin
  838. LCurDom := Lowercase(Items[i].Domain);
  839. if AStrings.IndexOf(LCurDom) = -1 then
  840. begin
  841. AStrings.Add(LCurDom);
  842. end;
  843. end;
  844. end;
  845. end;
  846.  
  847. procedure TIdEMailAddressList.AddressesByDomain(AList: TIdEMailAddressList;
  848. const ADomain: string);
  849. var
  850. i: Integer;
  851. LDomain: string;
  852. LCurDom: string;
  853. LEnt: TIdEMailAddressItem;
  854. begin
  855. LDomain := LowerCase(ADomain);
  856. AList.Clear;
  857. for i := 0 to Count - 1 do
  858. begin
  859. LCurDom := LowerCase(Items[i].Domain);
  860. if LCurDom = LDomain then
  861. begin
  862. LEnt := AList.Add;
  863. LEnt.Text := Items[i].Text;
  864. end;
  865. end;
  866. end;
  867.  
  868. end.
  869.