KOLIndy/myindy/IdSMTP.pas

   1 // 27-nov-2002
   2 unit IdSMTP;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } ,
   8   IdGlobal,
   9   IdMessage,
  10   IdEMailAddress,
  11   IdHeaderList,
  12   IdMessageClient;
  13
  14 type
  15   TAuthenticationType = (atNone, atLogin);
  16
  17 const
  18   ID_TIDSMTP_AUTH_TYPE = atNone;
  19
  20 type
  21   TIdSMTP = object(TIdMessageClient)
  22   protected
  23     FDidAuthenticate: Boolean;
  24     FAuthenticationType: TAuthenticationType;
  25     FMailAgent: string;
  26     FPassword: string;
  27     FUserId: string;
  28
  29     procedure GetAuthTypes;
  30     function IsAuthProtocolAvailable(Auth: TAuthenticationType)
  31       : Boolean; virtual;
  32   public
  33     AuthSchemesSupported: PStrList;
  34
  35     procedure Assign(Source: {TPersistent}PObj); virtual;//override;
  36     function Authenticate: Boolean; virtual;
  37     procedure Connect; virtual;//override;
  38      { constructor Create(AOwner: TComponent); override;
  39      } destructor Destroy;
  40      virtual; procedure Disconnect; virtual;//override;
  41 {    object (TObj)}procedure QuickSend(const AHost, ASubject, ATo,
  42       AFrom, AText: string);
  43     procedure Send(AMsg: PIdMessage); virtual;
  44
  45 //    property AuthSchemesSupported: TStringList read FAuthSchemesSupported;
  46    { published }
  47     property AuthenticationType: TAuthenticationType read FAuthenticationType
  48     write FAuthenticationType default ID_TIDSMTP_AUTH_TYPE;
  49     property MailAgent: string read FMailAgent write FMailAgent;
  50     property Password: string read FPassword write FPassword;
  51     property UserId: string read FUserId write FUserId;
  52     //property Port default IdPORT_SMTP;
  53   end;
  54 PIdSMTP=^TIdSMTP;
  55 function NewIdSMTP(AOwner: {TComponent}PControl):PIdSMTP;
  56
  57 implementation
  58
  59 uses
  60   IdCoder3To4,
  61   IdResourceStrings;
  62
  63 procedure TIdSMTP.Assign(Source: {TPersistent}Pobj);
  64 begin
  65 {  if Source is TIdSMTP then
  66   begin
  67     AuthenticationType := TIdSMTP(Source).AuthenticationType;
  68     Host := TIdSMTP(Source).Host;
  69     MailAgent := TIdSMTP(Source).MailAgent;
  70     Password := TIdSMTP(Source).Password;
  71     Port := TIdSMTP(Source).Port;
  72     UserId := TIdSMTP(Source).UserId;
  73   end
  74   else
  75     inherited;}
  76 end;
  77
  78 function TIdSMTP.Authenticate: Boolean;
  79
  80   function AuthLogin: Boolean;
  81   begin
  82     SendCmd('auth LOGIN', 334); {Do not localize}
  83     SendCmd(Base64Encode(UserId), 334);
  84     SendCmd(Base64Encode(Password), 235);
  85     Result := True;
  86   end;
  87
  88 begin
  89   Result := False;
  90   case FAUthenticationType of
  91     atLogin: Result := AuthLogin;
  92   end;
  93   FDidAuthenticate := True;
  94 end;
  95
  96 procedure TIdSMTP.Connect;
  97 begin
  98   inherited;
  99   try
 100     GetResponse([220]);
 101     AuthSchemesSupported.Clear;
 102     if SendCmd('ehlo ' + LocalName) = 250 then {Do not localize}
 103     begin
 104       GetAuthTypes;
 105     end
 106     else
 107     begin
 108       SendCmd('Helo ' + LocalName, 250); {Do not localize}
 109     end;
 110   except
 111     Disconnect;
 112     raise;
 113   end;
 114 end;
 115
 116 //constructor TIdSMTP.Create(AOwner: TComponent);
 117 function NewIdSMTP(AOwner: PControl):PIdSMTP;
 118 begin
 119   New( Result, Create );
 120 with Result^ do
 121 begin
 122 //  inherited;
 123   AuthSchemesSupported := NewStrList;
 124   Port := IdPORT_SMTP;
 125 end;
 126 end;
 127
 128 destructor TIdSMTP.Destroy;
 129 begin
 130 //  FreeAndNil(FAuthSchemesSupported);
 131   inherited;
 132 end;
 133
 134 procedure TIdSMTP.Disconnect;
 135 begin
 136   try
 137     if Connected then
 138     begin
 139       WriteLn('Quit'); {Do not localize}
 140     end;
 141   finally
 142     inherited;
 143     FDidAuthenticate := False;
 144   end;
 145 end;
 146
 147 procedure TIdSMTP.GetAuthTypes;
 148 var
 149   Iterator: Integer;
 150   Buffer: string;
 151   ListEntry: string;
 152 begin
 153   Iterator := 1;
 154   while Iterator < FCmdResultDetails.Count do
 155   begin
 156 //    Buffer := UpperCase(FCmdResultDetails[Iterator]);
 157     if (IndyPos('AUTH', Buffer) = 5) and ((Copy(Buffer, 9, 1) = ' ') or
 158       {Do not localize}
 159       (Copy(Buffer, 9, 1) = '=')) then {Do not localize}
 160     begin
 161       Buffer := Copy(Buffer, 10, Length(Buffer));
 162       while Buffer <> '' do
 163       begin
 164         while StrReplace(Buffer, '=', ' ') do; {Do not localize}
 165         ListEntry := Fetch(Buffer, ' '); {Do not localize}
 166 //        if (FAuthSchemesSupported.IndexOf(ListEntry) = -1) then
 167 //          FAuthSchemesSupported.Add(ListEntry);
 168       end;
 169     end;
 170     Inc(Iterator);
 171   end;
 172 end;
 173
 174 function TIdSMTP.IsAuthProtocolAvailable(
 175   Auth: TAuthenticationType): Boolean;
 176 begin
 177 (*  case Auth of
 178     atLogin: Result := (FAuthSchemesSupported.IndexOf('LOGIN') <> -1);
 179       {Do not localize}
 180   else
 181     Result := False;
 182   end;*)
 183 end;
 184
 185 {class} procedure TIdSMTP.QuickSend(const AHost, ASubject, ATo,
 186   AFrom, AText: string);
 187 var
 188   SMTP: TIdSMTP;
 189   Msg: TIdMessage;
 190 begin
 191 (*  SMTP := TIdSMTP.Create(nil);
 192   try
 193     Msg := TIdMessage.Create(SMTP);
 194     with Msg do
 195     begin
 196       Subject := ASubject;
 197       Recipients.EMailAddresses := ATo;
 198       From.Text := AFrom;
 199       Body.Text := AText;
 200     end;
 201     with SMTP do
 202     begin
 203       Host := AHost;
 204       Connect;
 205       try
 206         ;
 207         Send(Msg);
 208       finally
 209         Disconnect;
 210       end;
 211     end;
 212   finally
 213     SMTP.Free;
 214   end;*)
 215 end;
 216
 217 procedure TIdSMTP.Send(AMsg: PIdMessage);
 218
 219   procedure WriteRecipient(const AEmailAddress: pIdEmailAddressItem);
 220   begin
 221     SendCmd('RCPT to:<' + AEMailAddress.Address + '>', 250); {Do not localize}
 222   end;
 223
 224   procedure WriteRecipients(AList: pIdEmailAddressList);
 225   var
 226     i: integer;
 227   begin
 228     for i := 0 to AList.count - 1 do
 229     begin
 230       WriteRecipient(AList.Items[i]);
 231     end;
 232   end;
 233
 234   function NeedToAuthenticate: Boolean;
 235   begin
 236     if FAuthenticationType <> atNone then
 237     begin
 238       Result := IsAuthProtocolAvailable(FAuthenticationType)
 239         and (FDidAuthenticate = False);
 240     end
 241     else
 242     begin
 243       Result := False;
 244     end;
 245   end;
 246
 247 begin
 248   SendCmd('Rset'); {Do not localize}
 249   if NeedToAuthenticate then
 250   begin
 251     Authenticate;
 252   end;
 253   SendCmd('Mail from:<' + AMsg.From.Address + '>', 250); {Do not localize}
 254   WriteRecipients(AMsg.Recipients);
 255   WriteRecipients(AMsg.CCList);
 256   WriteRecipients(AMsg.BccList);
 257   SendCmd('Data', 354); {Do not localize}
 258   AMsg.ExtraHeaders.Values['X-Mailer'] := MailAgent; {Do not localize}
 259   SendMsg(AMsg);
 260   SendCmd('.', 250); {Do not localize}
 261 end;
 262
 263 end.