home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / SYNAPSE.ZIP / source / lib / IMAPsend.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-07  |  19KB  |  626 lines
  1. {==============================================================================|
  2. | Project : Delphree - Synapse                                   | 002.001.000 |
  3. |==============================================================================|
  4. | Content: IMAP4rev1 client                                                    |
  5. |==============================================================================|
  6. | Copyright (c)1999-2002, Lukas Gebauer                                        |
  7. | All rights reserved.                                                         |
  8. |                                                                              |
  9. | Redistribution and use in source and binary forms, with or without           |
  10. | modification, are permitted provided that the following conditions are met:  |
  11. |                                                                              |
  12. | Redistributions of source code must retain the above copyright notice, this  |
  13. | list of conditions and the following disclaimer.                             |
  14. |                                                                              |
  15. | Redistributions in binary form must reproduce the above copyright notice,    |
  16. | this list of conditions and the following disclaimer in the documentation    |
  17. | and/or other materials provided with the distribution.                       |
  18. |                                                                              |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may      |
  20. | be used to endorse or promote products derived from this software without    |
  21. | specific prior written permission.                                           |
  22. |                                                                              |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
  33. | DAMAGE.                                                                      |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c)2001-2002.                |
  37. | All Rights Reserved.                                                         |
  38. |==============================================================================|
  39. | Contributor(s):                                                              |
  40. |==============================================================================|
  41. | History: see HISTORY.HTM from distribution package                           |
  42. |          (Found at URL: http://www.ararat.cz/synapse/)                       |
  43. |==============================================================================}
  44.  
  45. {$WEAKPACKAGEUNIT ON}
  46.  
  47. //RFC-2060
  48. //RFC-2595
  49.  
  50. unit IMAPsend;
  51.  
  52. interface
  53.  
  54. uses
  55.   SysUtils, Classes,
  56.   blcksock, SynaUtil, SynaCode;
  57.  
  58. const
  59.   cIMAPProtocol = '143';
  60.  
  61. type
  62.   TIMAPSend = class(TSynaClient)
  63.   private
  64.     FSock: TTCPBlockSocket;
  65.     FTagCommand: integer;
  66.     FResultString: string;
  67.     FFullResult: TStringList;
  68.     FIMAPcap: TStringList;
  69.     FUsername: string;
  70.     FPassword: string;
  71.     FAuthDone: Boolean;
  72.     FSelectedFolder: string;
  73.     FSelectedCount: integer;
  74.     FSelectedRecent: integer;
  75.     FSelectedUIDvalidity: integer;
  76.     FUID: Boolean;
  77.     FAutoTLS: Boolean;
  78.     FFullSSL: Boolean;
  79.     function ReadResult: string;
  80.     function AuthLogin: Boolean;
  81.     function Connect: Boolean;
  82.     procedure ParseMess(Value:TStrings);
  83.     procedure ParseFolderList(Value:TStrings);
  84.     procedure ParseSelect;
  85.     procedure ParseSearch(Value:TStrings);
  86.   public
  87.     constructor Create;
  88.     destructor Destroy; override;
  89.     function IMAPcommand(Value: string): string;
  90.     function IMAPuploadCommand(Value: string; const Data:TStrings): string;
  91.     function Capability: Boolean;
  92.     function Login: Boolean;
  93.     procedure Logout;
  94.     function NoOp: Boolean;
  95.     function List(FromFolder: string; const FolderList: TStrings): Boolean;
  96.     function ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
  97.     function CreateFolder(FolderName: string): Boolean;
  98.     function DeleteFolder(FolderName: string): Boolean;
  99.     function RenameFolder(FolderName, NewFolderName: string): Boolean;
  100.     function SubscribeFolder(FolderName: string): Boolean;
  101.     function UnsubscribeFolder(FolderName: string): Boolean;
  102.     function SelectFolder(FolderName: string): Boolean;
  103.     function SelectROFolder(FolderName: string): Boolean;
  104.     function CloseFolder: Boolean;
  105.     function StatusFolder(FolderName, Value: string): integer;
  106.     function ExpungeFolder: Boolean;
  107.     function CheckFolder: Boolean;
  108.     function AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
  109.     function DeleteMess(MessID: integer): boolean;
  110.     function FetchMess(MessID: integer; const Mess: TStrings): Boolean;
  111.     function FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
  112.     function MessageSize(MessID: integer): integer;
  113.     function CopyMess(MessID: integer; ToFolder: string): Boolean;
  114.     function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
  115.     function SetFlagsMess(MessID: integer; Flags: string): Boolean;
  116.     function GetFlagsMess(MessID: integer; var Flags: string): Boolean;
  117.     function StartTLS: Boolean;
  118.     function FindCap(const Value: string): string;
  119.   published
  120.     property ResultString: string read FResultString;
  121.     property FullResult: TStringList read FFullResult;
  122.     property IMAPcap: TStringList read FIMAPcap;
  123.     property Username: string read FUsername Write FUsername;
  124.     property Password: string read FPassword Write FPassword;
  125.     property AuthDone: Boolean read FAuthDone;
  126.     property UID: Boolean read FUID Write FUID;
  127.     property Sock: TTCPBlockSocket read FSock;
  128.     property SelectedFolder: string read FSelectedFolder;
  129.     property SelectedCount: integer read FSelectedCount;
  130.     property SelectedRecent: integer read FSelectedRecent;
  131.     property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
  132.     property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
  133.     property FullSSL: Boolean read FFullSSL Write FFullSSL;
  134.   end;
  135.  
  136. implementation
  137.  
  138. const
  139.   CRLF = #13#10;
  140.  
  141. constructor TIMAPSend.Create;
  142. begin
  143.   inherited Create;
  144.   FFullResult := TStringList.Create;
  145.   FIMAPcap := TStringList.Create;
  146.   FSock := TTCPBlockSocket.Create;
  147.   FSock.CreateSocket;
  148.   FSock.SizeRecvBuffer := 32768;
  149.   FSock.SizeSendBuffer := 32768;
  150.   FSock.ConvertLineEnd := True;
  151.   FTimeout := 300000;
  152.   FTargetPort := cIMAPProtocol;
  153.   FUsername := '';
  154.   FPassword := '';
  155.   FTagCommand := 0;
  156.   FSelectedFolder := '';
  157.   FSelectedCount := 0;
  158.   FSelectedRecent := 0;
  159.   FSelectedUIDvalidity := 0;
  160.   FUID := False;
  161.   FAutoTLS := False;
  162.   FFullSSL := False;
  163. end;
  164.  
  165. destructor TIMAPSend.Destroy;
  166. begin
  167.   FSock.Free;
  168.   FIMAPcap.Free;
  169.   FFullResult.Free;
  170.   inherited Destroy;
  171. end;
  172.  
  173.  
  174. function TIMAPSend.ReadResult: string;
  175. var
  176.   s: string;
  177.   x, l: integer;
  178. begin
  179.   Result := '';
  180.   FFullResult.Clear;
  181.   FResultString := '';
  182.   repeat
  183.     s := FSock.RecvString(FTimeout);
  184.     if Pos('S' + IntToStr(FTagCommand) + ' ', s) = 1 then
  185.     begin
  186.       FResultString := s;
  187.       break;
  188.     end
  189.     else
  190.       FFullResult.Add(s);
  191.     if (s <> '') and (s[Length(s)]='}') then
  192.     begin
  193.       s := Copy(s, 1, Length(s) - 1);
  194.       x := RPos('{', s);
  195.       s := Copy(s, x + 1, Length(s) - x);
  196.       l := StrToIntDef(s, -1);
  197.       if l <> -1 then
  198.       begin
  199.         setlength(s, l);
  200.         x := FSock.recvbufferex(PChar(s), l, FTimeout);
  201.         SetLength(s, x);
  202.         FFullResult.Add(s);
  203.       end;
  204.     end;
  205.   until FSock.LastError <> 0;
  206.   s := separateright(FResultString, ' ');
  207.   Result:=uppercase(separateleft(s, ' '));
  208. end;
  209.  
  210. function TIMAPSend.IMAPcommand(Value: string): string;
  211. begin
  212.   Inc(FTagCommand);
  213.   FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + CRLF);
  214.   Result := ReadResult;
  215. end;
  216.  
  217. function TIMAPSend.IMAPuploadCommand(Value: string; const Data:TStrings): string;
  218. var
  219.   l: integer;
  220. begin
  221.   Inc(FTagCommand);
  222.   l := Length(Data.Text);
  223.   FSock.SendString(IntToStr(FTagCommand) + ' ' + Value + ' {'+ IntToStr(l) + '}' + CRLF);
  224.   FSock.SendString(Data.Text + CRLF);
  225.   Result := ReadResult;
  226. end;
  227.  
  228. procedure TIMAPSend.ParseMess(Value:TStrings);
  229. var
  230.   n: integer;
  231. begin
  232.   Value.Clear;
  233.   for n := 0 to FFullResult.Count - 2 do
  234.     if FFullResult[n][Length(FFullResult[n])] = '}' then
  235.     begin
  236.       Value.Text := FFullResult[n + 1];
  237.       Break;
  238.     end;
  239. end;
  240.  
  241. procedure TIMAPSend.ParseFolderList(Value:TStrings);
  242. var
  243.   n, x: integer;
  244.   s: string;
  245. begin
  246.   Value.Clear;
  247.   for n := 0 to FFullResult.Count - 1 do
  248.   begin
  249.     s := FFullResult[n];
  250.     x := RPos(' ', s);
  251.     if (x > 0) and (Pos('NOSELECT', UpperCase(s)) = 0) then
  252.       Value.Add(Copy(s, x + 1, Length(s) - x));
  253.   end;
  254. end;
  255.  
  256. procedure TIMAPSend.ParseSelect;
  257. var
  258.   n: integer;
  259.   s, t: string;
  260. begin
  261.   FSelectedCount := 0;
  262.   FSelectedRecent := 0;
  263.   FSelectedUIDvalidity := 0;
  264.   for n := 0 to FFullResult.Count - 1 do
  265.   begin
  266.     s := uppercase(FFullResult[n]);
  267.     if Pos(' EXISTS', s) > 0 then
  268.     begin
  269.       t := separateleft(s, ' EXISTS');
  270.       t := separateright(t, '* ');
  271.       FSelectedCount := StrToIntDef(t, 0);
  272.     end;
  273.     if Pos(' RECENT', s) > 0 then
  274.     begin
  275.       t := separateleft(s, ' RECENT');
  276.       t := separateright(t, '* ');
  277.       FSelectedRecent := StrToIntDef(t, 0);
  278.     end;
  279.     if Pos('UIDVALIDITY', s) > 0 then
  280.     begin
  281.       t := separateright(s, 'UIDVALIDITY ');
  282.       t := separateleft(t, ']');
  283.       FSelectedUIDvalidity := StrToIntDef(t, 0);
  284.     end;
  285.   end;
  286. end;
  287.  
  288. procedure TIMAPSend.ParseSearch(Value:TStrings);
  289. var
  290.   n: integer;
  291.   s: string;
  292. begin
  293.   Value.Clear;
  294.   for n := 0 to FFullResult.Count - 1 do
  295.   begin
  296.     s := uppercase(FFullResult[n]);
  297.     if Pos('* SEARCH', s) = 1 then
  298.     begin
  299.       s := SeparateRight(s, '* SEARCH');
  300.       while s <> '' do
  301.         Value.Add(Fetch(s, ' '));
  302.     end;
  303.   end;
  304. end;
  305.  
  306. function TIMAPSend.FindCap(const Value: string): string;
  307. var
  308.   n: Integer;
  309.   s: string;
  310. begin
  311.   s := UpperCase(Value);
  312.   Result := '';
  313.   for n := 0 to FIMAPcap.Count - 1 do
  314.     if Pos(s, UpperCase(FIMAPcap[n])) = 1 then
  315.     begin
  316.       Result := FIMAPcap[n];
  317.       Break;
  318.     end;
  319. end;
  320.  
  321. function TIMAPSend.AuthLogin: Boolean;
  322. begin
  323.   Result := IMAPcommand('LOGIN ' + FUsername + ' ' + FPassword) = 'OK';
  324. end;
  325.  
  326. function TIMAPSend.Connect: Boolean;
  327. begin
  328.   FSock.CloseSocket;
  329.   FSock.CreateSocket;
  330.   if FFullSSL then
  331.     FSock.SSLEnabled := True;
  332.   FSock.Bind(FIPInterface, cAnyPort);
  333.   FSock.Connect(FTargetHost, FTargetPort);
  334.   Result := FSock.LastError = 0;
  335. end;
  336.  
  337. function TIMAPSend.Capability: Boolean;
  338. var
  339.   n: Integer;
  340.   s, t: string;
  341. begin
  342.   Result := False;
  343.   FIMAPcap.Clear;
  344.   s := IMAPcommand('CAPABILITY');
  345.   if s = 'OK' then
  346.   begin
  347.     for n := 0 to FFullResult.Count - 1 do
  348.       if Pos('* CAPABILITY ', FFullResult[n]) = 1 then
  349.       begin
  350.         s := SeparateRight(FFullResult[n], '* CAPABILITY ');
  351.         while not (s = '') do
  352.         begin
  353.           t := separateleft(s, ' ');
  354.           s := separateright(s, ' ');
  355.           if s = t then
  356.             s := '';
  357.           FIMAPcap.Add(t);
  358.         end;
  359.       end;
  360.     Result := True;
  361.   end;
  362. end;
  363.  
  364. function TIMAPSend.Login: Boolean;
  365. var
  366.   s: string;
  367. begin
  368.   FSelectedFolder := '';
  369.   FSelectedCount := 0;
  370.   FSelectedRecent := 0;
  371.   FSelectedUIDvalidity := 0;
  372.   Result := False;
  373.   FAuthDone := False;
  374.   if not Connect then
  375.     Exit;
  376.   s := FSock.RecvString(FTimeout);
  377.   if Pos('* PREAUTH', s) = 1 then
  378.     FAuthDone := True
  379.   else
  380.     if Pos('* OK', s) = 1 then
  381.       FAuthDone := False
  382.     else
  383.       Exit;
  384.   if Capability then
  385.   begin
  386.     if Findcap('IMAP4rev1') = '' then
  387.       Exit;
  388.     if FAutoTLS and (Findcap('STARTTLS') <> '') then
  389.       if StartTLS then
  390.         Capability;
  391.   end;
  392.   Result := AuthLogin;
  393. end;
  394.  
  395. procedure TIMAPSend.Logout;
  396. begin
  397.   IMAPcommand('LOGOUT');
  398.   FSelectedFolder := '';
  399.   FSock.CloseSocket;
  400. end;
  401.  
  402. function TIMAPSend.NoOp: Boolean;
  403. begin
  404.   Result := IMAPcommand('NOOP') = 'OK';
  405. end;
  406.  
  407. function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean;
  408. begin
  409.   Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK';
  410.   ParseFolderList(FolderList);
  411. end;
  412.  
  413. function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
  414. begin
  415.   Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK';
  416.   ParseFolderList(FolderList);
  417. end;
  418.  
  419. function TIMAPSend.CreateFolder(FolderName: string): Boolean;
  420. begin
  421.   Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK';
  422. end;
  423.  
  424. function TIMAPSend.DeleteFolder(FolderName: string): Boolean;
  425. begin
  426.   Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK';
  427. end;
  428.  
  429. function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean;
  430. begin
  431.   Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK';
  432. end;
  433.  
  434. function TIMAPSend.SubscribeFolder(FolderName: string): Boolean;
  435. begin
  436.   Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK';
  437. end;
  438.  
  439. function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean;
  440. begin
  441.   Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK';
  442. end;
  443.  
  444. function TIMAPSend.SelectFolder(FolderName: string): Boolean;
  445. begin
  446.   Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK';
  447.   FSelectedFolder := FolderName;
  448.   ParseSelect;
  449. end;
  450.  
  451. function TIMAPSend.SelectROFolder(FolderName: string): Boolean;
  452. begin
  453.   Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK';
  454.   FSelectedFolder := FolderName;
  455.   ParseSelect;
  456. end;
  457.  
  458. function TIMAPSend.CloseFolder: Boolean;
  459. begin
  460.   Result := IMAPcommand('CLOSE') = 'OK';
  461.   FSelectedFolder := '';
  462. end;
  463.  
  464. function TIMAPSend.StatusFolder(FolderName, Value: string): integer;
  465. var
  466.   n: integer;
  467.   s, t: string;
  468. begin
  469.   Result := -1;
  470.   Value := Uppercase(Value);
  471.   if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then
  472.     for n := 0 to FFullResult.Count - 1 do
  473.     begin
  474.       s := UpperCase(FFullResult[n]);
  475.       if (Pos('* STATUS ', s) = 1) and (Pos(Value, s) > 0 ) then
  476.       begin
  477.         t := SeparateRight(s, Value);
  478.         t := SeparateLeft(t, ')');
  479.         t := trim(t);
  480.         Result := StrToIntDef(t, -1);
  481.         Break;
  482.       end;
  483.     end;
  484. end;
  485.  
  486. function TIMAPSend.ExpungeFolder: Boolean;
  487. begin
  488.   Result := IMAPcommand('EXPUNGE') = 'OK';
  489. end;
  490.  
  491. function TIMAPSend.CheckFolder: Boolean;
  492. begin
  493.   Result := IMAPcommand('CHECK') = 'OK';
  494. end;
  495.  
  496. function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
  497. begin
  498.   Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK';
  499. end;
  500.  
  501. function TIMAPSend.DeleteMess(MessID: integer): boolean;
  502. var
  503.   s: string;
  504. begin
  505.   s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)';
  506.   if FUID then
  507.     s := 'UID ' + s;
  508.   Result := IMAPcommand(s) = 'OK';
  509. end;
  510.  
  511. function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean;
  512. var
  513.   s: string;
  514. begin
  515.   s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)';
  516.   if FUID then
  517.     s := 'UID ' + s;
  518.   Result := IMAPcommand(s) = 'OK';
  519.   ParseMess(Mess);
  520. end;
  521.  
  522. function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
  523. var
  524.   s: string;
  525. begin
  526.   s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)';
  527.   if FUID then
  528.     s := 'UID ' + s;
  529.   Result := IMAPcommand(s) = 'OK';
  530.   ParseMess(Headers);
  531. end;
  532.  
  533. function TIMAPSend.MessageSize(MessID: integer): integer;
  534. var
  535.   n: integer;
  536.   s, t: string;
  537. begin
  538.   Result := -1;
  539.   s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)';
  540.   if FUID then
  541.     s := 'UID ' + s;
  542.   if IMAPcommand(s) = 'OK' then
  543.     for n := 0 to FFullResult.Count - 1 do
  544.     begin
  545.       s := UpperCase(FFullResult[n]);
  546.       if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then
  547.       begin
  548.         t := SeparateRight(s, 'RFC822.SIZE ');
  549.         t := SeparateLeft(t, ')');
  550.         t := trim(t);
  551.         Result := StrToIntDef(t, -1);
  552.         Break;
  553.       end;
  554.     end;
  555. end;
  556.  
  557. function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
  558. var
  559.   s: string;
  560. begin
  561.   s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"';
  562.   if FUID then
  563.     s := 'UID ' + s;
  564.   Result := IMAPcommand(s) = 'OK';
  565. end;
  566.  
  567. function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
  568. var
  569.   s: string;
  570. begin
  571.   s := 'SEARCH ' + Criteria;
  572.   if FUID then
  573.     s := 'UID ' + s;
  574.   Result := IMAPcommand(s) = 'OK';
  575.   ParseSearch(FoundMess);
  576. end;
  577.  
  578. function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean;
  579. var
  580.   s: string;
  581. begin
  582.   s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')';
  583.   if FUID then
  584.     s := 'UID ' + s;
  585.   Result := IMAPcommand(s) = 'OK';
  586. end;
  587.  
  588. function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
  589. var
  590.   s: string;
  591.   n: integer;
  592. begin
  593.   Flags := '';
  594.   s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)';
  595.   if FUID then
  596.     s := 'UID ' + s;
  597.   Result := IMAPcommand(s) = 'OK';
  598.   for n := 0 to FFullResult.Count - 1 do
  599.   begin
  600.     s := uppercase(FFullResult[n]);
  601.     if Pos('* FETCH (FLAGS', s) = 1 then
  602.     begin
  603.       s := SeparateRight(s, 'FLAGS');
  604.       s := Separateright(s, '(');
  605.       Flags := SeparateLeft(s, ')');
  606.     end;
  607.   end;
  608. end;
  609.  
  610. function TIMAPSend.StartTLS: Boolean;
  611. begin
  612.   Result := False;
  613.   if FindCap('STARTTLS') <> '' then
  614.   begin
  615.     if IMAPcommand('STARTTLS') = 'OK' then
  616.     begin
  617.       Fsock.SSLDoConnect;
  618.       Result := FSock.LastError = 0;
  619.     end;
  620.   end;
  621. end;
  622.  
  623. {==============================================================================}
  624.  
  625. end.
  626.