Download fixed wideidemailaddress.pas

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