units/synapse/pop3send.pas

   1 {==============================================================================|
   2 | Project : Delphree - Synapse                                   | 001.001.002 |
   3 |==============================================================================|
   4 | Content: POP3 client                                                         |
   5 |==============================================================================|
   6 | The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
   7 | (the "License"); you may not use this file except in compliance with the     |
   8 | License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
   9 |                                                                              |
  10 | Software distributed under the License is distributed on an "AS IS" basis,   |
  11 | WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
  12 | the specific language governing rights and limitations under the License.    |
  13 |==============================================================================|
  14 | The Original Code is Synapse Delphi Library.                                 |
  15 |==============================================================================|
  16 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  17 | Portions created by Lukas Gebauer are Copyright (c)2001.                     |
  18 | All Rights Reserved.                                                         |
  19 |==============================================================================|
  20 | Contributor(s):                                                              |
  21 |==============================================================================|
  22 | History: see HISTORY.HTM from distribution package                           |
  23 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
  24 |==============================================================================}
  25
  26 {$WEAKPACKAGEUNIT ON}
  27
  28 unit POP3send;
  29
  30 interface
  31
  32 uses
  33   KOL,
  34   blcksock, SynaUtil, SynaCode;
  35
  36 const
  37   cPop3Protocol = 'pop3';
  38
  39 type
  40   TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
  41
  42   PPOP3Send = ^TPOP3Send;
  43   TPOP3Send = object(TObj)
  44   private
  45     FSock: PTCPBlockSocket;
  46     FTimeout: Integer;
  47     FPOP3Host: string;
  48     FPOP3Port: string;
  49     FResultCode: Integer;
  50     FResultString: string;
  51     FFullResult: PStrList;
  52     FUsername: string;
  53     FPassword: string;
  54     FStatCount: Integer;
  55     FStatSize: Integer;
  56     FTimeStamp: string;
  57     FAuthType: TPOP3AuthType;
  58     function ReadResult(Full: Boolean): Integer;
  59     function Connect: Boolean;
  60     function AuthLogin: Boolean;
  61     function AuthApop: Boolean;
  62   public
  63     destructor Destroy; virtual;
  64     function Login: Boolean;
  65     procedure Logout;
  66     function Reset: Boolean;
  67     function NoOp: Boolean;
  68     function Stat: Boolean;
  69     function List(Value: Integer): Boolean;
  70     function Retr(Value: Integer): Boolean;
  71     function Dele(Value: Integer): Boolean;
  72     function Top(Value, Maxlines: Integer): Boolean;
  73     function Uidl(Value: Integer): Boolean;
  74     property Timeout: Integer read FTimeout Write FTimeout;
  75     property POP3Host: string read FPOP3Host Write FPOP3Host;
  76     property POP3Port: string read FPOP3Port Write FPOP3Port;
  77     property ResultCode: Integer read FResultCode;
  78     property ResultString: string read FResultString;
  79     property FullResult: PStrList read FFullResult;
  80     property Username: string read FUsername Write FUsername;
  81     property Password: string read FPassword Write FPassword;
  82     property StatCount: Integer read FStatCount;
  83     property StatSize: Integer read  FStatSize;
  84     property TimeStamp: string read FTimeStamp;
  85     property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
  86     property Sock: PTCPBlockSocket read FSock;
  87   end;
  88
  89
  90 function NewPOP3Send : PPOP3Send;
  91
  92
  93 implementation
  94
  95 const
  96   CRLF = #13#10;
  97
  98 function NewPOP3Send : PPOP3Send;
  99 begin
 100   New(Result,Create);
 101   Result.FFullResult := NewStrList;
 102   Result.FSock := NewTCPBlockSocket;
 103   Result.FSock.CreateSocket;
 104   Result.FTimeout := 300000;
 105   Result.FPOP3host := cLocalhost;
 106   Result.FPOP3Port := cPop3Protocol;
 107   Result.FUsername := '';
 108   Result.FPassword := '';
 109   Result.FStatCount := 0;
 110   Result.FStatSize := 0;
 111   Result.FAuthType := POP3AuthAll;
 112 end;
 113
 114 destructor TPOP3Send.Destroy;
 115 begin
 116   FSock.Free;
 117   FullResult.Free;
 118   inherited Destroy;
 119 end;
 120
 121 function TPOP3Send.ReadResult(Full: Boolean): Integer;
 122 var
 123   s: string;
 124 begin
 125   Result := 0;
 126   FFullResult.Clear;
 127   s := FSock.RecvString(FTimeout);
 128   if Pos('+OK', s) = 1 then
 129     Result := 1;
 130   FResultString := s;
 131   if Full and (Result = 1) then
 132     repeat
 133       s := FSock.RecvString(FTimeout);
 134       if s = '.' then
 135         Break;
 136       FFullResult.Add(s);
 137     until FSock.LastError <> 0;
 138   FResultCode := Result;
 139 end;
 140
 141 function TPOP3Send.AuthLogin: Boolean;
 142 begin
 143   Result := False;
 144   FSock.SendString('USER ' + FUserName + CRLF);
 145   if ReadResult(False) <> 1 then
 146     Exit;
 147   FSock.SendString('PASS ' + FPassword + CRLF);
 148   Result := ReadResult(False) = 1;
 149 end;
 150
 151 function TPOP3Send.AuthAPOP: Boolean;
 152 var
 153   s: string;
 154 begin
 155   s := StrToHex(MD5(FTimeStamp + FPassWord));
 156   FSock.SendString('APOP ' + FUserName + ' ' + s + CRLF);
 157   Result := ReadResult(False) = 1;
 158 end;
 159
 160 function TPOP3Send.Connect: Boolean;
 161 begin
 162   // Do not call this function! It is calling by LOGIN method!
 163   FStatCount := 0;
 164   FStatSize := 0;
 165   FSock.CloseSocket;
 166   FSock.LineBuffer := '';
 167   FSock.CreateSocket;
 168   FSock.Connect(POP3Host, POP3Port);
 169   Result := FSock.LastError = 0;
 170 end;
 171
 172 function TPOP3Send.Login: Boolean;
 173 var
 174   s, s1: string;
 175 begin
 176   Result := False;
 177   FTimeStamp := '';
 178   if not Connect then
 179     Exit;
 180   if ReadResult(False) <> 1 then
 181     Exit;
 182   s := SeparateRight(FResultString, '<');
 183   if s <> FResultString then
 184   begin
 185     s1 := SeparateLeft(s, '>');
 186     if s1 <> s then
 187       FTimeStamp := '<' + s1 + '>';
 188   end;
 189   Result := False;
 190   if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
 191     Result := AuthApop;
 192   if not Result and not (FAuthType = POP3AuthAPOP) then
 193     Result := AuthLogin;
 194 end;
 195
 196 procedure TPOP3Send.Logout;
 197 begin
 198   FSock.SendString('QUIT' + CRLF);
 199   ReadResult(False);
 200   FSock.CloseSocket;
 201 end;
 202
 203 function TPOP3Send.Reset: Boolean;
 204 begin
 205   FSock.SendString('RSET' + CRLF);
 206   Result := ReadResult(False) = 1;
 207 end;
 208
 209 function TPOP3Send.NoOp: Boolean;
 210 begin
 211   FSock.SendString('NOOP' + CRLF);
 212   Result := ReadResult(False) = 1;
 213 end;
 214
 215 function TPOP3Send.Stat: Boolean;
 216 var
 217   s: string;
 218 begin
 219   Result := False;
 220   FSock.SendString('STAT' + CRLF);
 221   if ReadResult(False) <> 1 then
 222     Exit;
 223   s := SeparateRight(ResultString, '+OK ');
 224   FStatCount := StrToIntDef(SeparateLeft(s, ' '), 0);
 225   FStatSize := StrToIntDef(SeparateRight(s, ' '), 0);
 226   Result := True;
 227 end;
 228
 229 function TPOP3Send.List(Value: Integer): Boolean;
 230 begin
 231   if Value = 0 then
 232     FSock.SendString('LIST' + CRLF)
 233   else
 234     FSock.SendString('LIST ' + Int2Str(Value) + CRLF);
 235   Result := ReadResult(Value = 0) = 1;
 236 end;
 237
 238 function TPOP3Send.Retr(Value: Integer): Boolean;
 239 begin
 240   FSock.SendString('RETR ' + Int2Str(Value) + CRLF);
 241   Result := ReadResult(True) = 1;
 242 end;
 243
 244 function TPOP3Send.Dele(Value: Integer): Boolean;
 245 begin
 246   FSock.SendString('DELE ' + Int2Str(Value) + CRLF);
 247   Result := ReadResult(False) = 1;
 248 end;
 249
 250 function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
 251 begin
 252   FSock.SendString('TOP ' + Int2Str(Value) + ' ' + Int2Str(Maxlines) + CRLF);
 253   Result := ReadResult(True) = 1;
 254 end;
 255
 256 function TPOP3Send.Uidl(Value: Integer): Boolean;
 257 begin
 258   if Value = 0 then
 259     FSock.SendString('UIDL' + CRLF)
 260   else
 261     FSock.SendString('UIDL ' + Int2Str(Value) + CRLF);
 262   Result := ReadResult(Value = 0) = 1;
 263 end;
 264
 265 end.