alsmtpclient.pas

Description: TALsmtpClient class implements the SMTP protocol (RFC-821)

    end;
    CheckError(WinSock.Connect(FSocketDescriptor,SockAddr,SizeOf(SockAddr))=SOCKET_ERROR);
  end;

begin
  if FConnected then raise Exception.Create('SMTP component already connected');

  Try

    WSAStartup (MAKEWORD(2,2), FWSAData);
    CallServer(aHost,aPort);
    CheckError(setsockopt(FSocketDescriptor,SOL_SOCKET,SO_RCVTIMEO,PChar(@FTimeOut),SizeOf(Integer))=SOCKET_ERROR);
    CheckError(setsockopt(FSocketDescriptor,SOL_SOCKET,SO_SNDTIMEO,PChar(@FTimeOut),SizeOf(Integer))=SOCKET_ERROR);
    Result := GetResponse([220]);
    FAuthTypesSupported := [];
    Fconnected := True;

  Except
    Disconnect;
    raise;
  end;

end;

{*********************************}
procedure TAlSmtpClient.Disconnect;
begin
  If Fconnected then begin
    ShutDown(FSocketDescriptor,SD_BOTH);
    CloseSocket(FSocketDescriptor);
    FSocketDescriptor := INVALID_SOCKET;
    if FWSAData.wVersion = 2 then WSACleanup;
    FWSAData.wVersion := 0;
    Fconnected := False;
  end;
end;

{********************}
{EhloResponse is like:
 250-ec-is.net Hello your_name, ravi de vous rencontrer
 250-VRFY
 250-ETRN
 250-AUTH=LOGIN
 250-AUTH LOGIN CRAM-MD5
 250-8BITMIME
 250 SIZE 0}
Function TAlSmtpClient.GetAuthTypeFromEhloResponse(EhloResponse: string): TAlSmtpClientAuthTypeSet;
var k, J: Integer;
    Str1, Str2: String;
    Lst: TStringlist;
begin
  Result := [];
  Lst := TstringList.Create;
  Try
    Lst.Text := AlUpperCase(Trim(EhloResponse));
    For j := 0 to Lst.Count - 1 do begin
      Str1 := trim(Lst[J]);  //250-AUTH=LOGIN
      Delete(Str1, 1, 4); //AUTH=LOGIN
      Str2 := AlCopyStr(Str1, 1, 5); //AUTH=
      if (str2='AUTH ') or (Str2='AUTH=') then begin
        Str1 := AlCopyStr(Str1, 6, maxint); //LOGIN
        Str1 := AlStringReplace(Str1, '=', ' ', [rfReplaceAll]); //LOGIN
        while (str1 <> '') do begin
          K := AlCharPos(' ', Str1);
          if K <= 0 then begin
            Str2 := trim(Str1);
            Str1 := '';
          end
          else begin
            Str2 := Trim(AlCopyStr(Str1, 1, k - 1));
            Delete(Str1, 1, k);
          end;

          if Str2 = ('PLAIN') then result := result + [AlsmtpClientAuthPlain]
          else if Str2 = ('LOGIN') then result := result + [AlsmtpClientAuthLogin]
          else if Str2 = ('CRAM-MD5') then result := result + [AlsmtpClientAuthCramMD5]
          else if Str2 = ('CRAM-SHA1') then result := result + [AlsmtpClientAuthCramSHA1];

        end;
      end;
    end;
  finally
    Lst.free;
  end;
end;

{****************************************************************************************}
{This command is used to identify the sender-SMTP to the receiver-SMTP. The argument field
 contains the host name of the sender-SMTP. The receiver-SMTP identifies itself to the
 sender-SMTP in the connection greeting reply, and in the response to this command.
 This command and an OK reply to it confirm that both the sender-SMTP and the receiver-SMTP
 are in the initial state, that is, there is no transaction in progress and all state tables
 and buffers are cleared.}
Function TAlSmtpClient.Helo: String;
begin
  Result := SendCmd('HELO '+AlGetLocalHostName,[250]);
end;

{**********************************}
Function TAlSmtpClient.Ehlo: String;
begin
  result := SendCmd('EHLO '+AlGetLocalHostName,[250]);
  FAuthTypesSupported := GetAuthTypeFromEhloResponse(Result);
end;

{****************************************************************************}
{This command is used to initiate a mail transaction in which the mail data is
 delivered to one or more mailboxes. The argument field contains a reverse-path.
 The reverse-path consists of an optional list of hosts and the sender mailbox. When
 the list of hosts is present, it is a "reverse" source route and indicates that the
 mail was relayed through each host on the list (the first host in the list was the
 most recent relay). This list is used as a source route to return non-delivery notices
 to the sender. As each relay host adds itself to the beginning of the list, it must
 use its name as known in the IPCE to which it is relaying the mail rather than the IPCE
 from which the mail came (if they are different). In some types of error reporting
 messages (for example, undeliverable mail notifications) the reverse-path may be null.
 This command clears the reverse-path buffer, the forward-path buffer, and the mail data
 buffer; and inserts the reverse-path information from this command into the reverse-path buffer.}
Function TAlSmtpClient.MailFrom(aFromName: String): String;
begin
  aFromName := trim(aFromName);
  If aFromName = '' then raise Exception.Create('From name is empty');
  If AlPos(#13#10,aFromName) > 0 then raise Exception.Create('From name is invalid');
  Result := SendCmd('MAIL From:<'+aFromName+'>',[250]);
end;

{**************************************************************************************************}
Function TAlSmtpClient.Auth(AUserName, APassword: String; aAuthType: TalSmtpClientAuthType): String;

  {-----------------------------------}
  Function InternalDoAuthPlain: String;
  var aAuthPlain : String;
  begin
    If aUserName='' then raise Exception.Create('UserName is empty');
    If aPassword='' then raise Exception.Create('Password is empty');
    aAuthPlain := ALMimeBase64EncodeStringNoCRLF(aUserName + #0 + aUserName + #0 + aPassword);
    Result := SendCmd('AUTH PLAIN ' + aAuthPlain,[235]);
  end;

  {-----------------------------------}
  Function InternalDoAuthLogin: String;
  begin
    If aUserName='' then raise Exception.Create('UserName is empty');
    If aPassword='' then raise Exception.Create('Password is empty');
    SendCmd('AUTH LOGIN',[334]);
    SendCmd(ALMimeBase64EncodeStringNoCRLF(aUsername),[334]);
    Result := SendCmd(ALMimeBase64EncodeStringNoCRLF(aPassword),[235]);
  end;

var tmpAuthType: TAlSmtpClientAuthType;
begin

  if aAuthType = AlsmtpClientAuthAutoSelect then begin
    if AlsmtpClientAuthPlain in FAuthTypesSupported then tmpAuthType := AlsmtpClientAuthPlain
    else if AlsmtpClientAuthLogin in FAuthTypesSupported then tmpAuthType := AlsmtpClientAuthLogin
    else if AlsmtpClientAuthCramMD5 in FAuthTypesSupported then tmpAuthType := AlsmtpClientAuthCramMD5
    else if AlsmtpClientAuthCramSHA1 in FAuthTypesSupported then tmpAuthType := AlsmtpClientAuthCramSHA1
    else tmpAuthType := AlsmtpClientAuthNone
  end
  else tmpAuthType := aAuthType;

  case tmpAuthType of
    alsmtpClientAuthPlain : Result := InternalDoAuthPlain;
    alsmtpClientAuthLogin : result := InternalDoAuthLogin;
    alsmtpClientAuthCramMD5 : raise Exception.Create('CRAM-MD5 Authentication is not supported yet!');
    alsmtpClientAuthCramSHA1: raise Exception.Create('CRAM-SHA1 Authentication is not supported yet!');
    else raise exception.Create('No Authentication scheme found');
  end;

end;

{*************************************************************************}
{This command is used to identify an individual recipient of the mail data;
 multiple recipients are specified by multiple use of this command.}
Function TAlSmtpClient.RcptTo(aRcptNameLst: Tstrings): String;
Var i: integer;
    aRcptNameValue: String;
begin
  Result := '';
  if aRcptNameLst.Count <= 0 then raise Exception.Create('RcptName list is empty');
  For i := 0 to aRcptNameLst.Count - 1 do begin
    aRcptNameValue := trim(aRcptNameLst[i]);
    If (aRcptNameValue = '') or (AlPos(#13#10,aRcptNameValue) > 0) then raise Exception.Create('Bad entry in RcptName list');
    Result := Result + SendCmd('RCPT To:<'+aRcptNameValue+'>',[250, 251]) + #13#10;
  end;
  If result <> '' then delete(Result,Length(Result)-1,2);
end;

{********************************************************************************}
{The receiver treats the lines following the command as mail data from the sender.
 This command causes the mail data from this command to be appended to the mail data buffer.
 The mail data may contain any of the 128 ASCII character codes.
 The mail data is terminated by a line containing only a period, that is the character sequence "<CRLF>.<CRLF>".
 This is the end of mail data indication. The end of mail data indication requires that the receiver must now process
 the stored mail transaction information. This processing consumes the information in the reverse-path buffer,
 the forward-path buffer, and the mail data buffer, and on the completion of this command these buffers are cleared.
 If the processing is successful the receiver must send an OK reply. If the processing fails completely
 the receiver must send a failure reply. When the receiver-SMTP accepts a message either for relaying or for
 final delivery it inserts at the beginning of the mail data a time stamp line. The time stamp line indicates the
 identity of the host that sent the message, and the identity of the host that received the message (and is inserting this
 time stamp), and the date and time the message was received. Relayed messages will have multiple time stamp lines.
 When the receiver-SMTP makes the "final delivery" of a message it inserts at the beginning of the mail data a return path
 line. The return path line preserves the information in the <reverse-path> from the MAIL command. Here, final delivery
 means the message leaves the SMTP world. Normally, this would mean it has been delivered to the destination user, but
 in some cases it may be further processed and transmitted by another mail system.
 It is possible for the mailbox in the return path be different from the actual sender's mailbox, for example,
 if error responses are to be delivered a special error handling mailbox rather than the message senders.
 The preceding two paragraphs imply that the final mail data will begin with a return path line, followed
 by one or more time stamp lines. These lines will be followed by the mail data header and body [2].
 Special mention is needed of the response and further action required when the processing following the end of mail
 data indication is partially successful. This could arise if after accepting several recipients and the mail data,
 the receiver-SMTP finds that the mail data can be successfully delivered to some of the recipients, but it cannot
 be to others (for example, due to mailbox space allocation problems). In such a situation, the response to the DATA
 command must be an OK reply. But, the receiver-SMTP must compose and send an "undeliverable mail" notification
 message to the originator of the message. Either a single notification which lists all of the recipients that failed
 to get the message, or separate notification messages must be sent for each failed recipient. All undeliverable mail
 notification messages are sent using the MAIL command (even if they result from processing a SEND, SOML, or SAML command).}
Function TAlSmtpClient.Data(aMailData: String): String;
Var I : Integer;
begin
  SendCmd('DATA',[354]);

  i := 2;
  while i <= Length(aMailData) Do begin
    If (aMailData[i] = '.') and (aMailData[i-1] = #10) and (aMailData[i-2] = #13) then Insert('.',aMailData,i);
    inc(i);
  end;

  Result := SendCmd(aMailData + #13#10 + '.',[250]);

end;

{**********************************************************}
Function TAlSmtpClient.Data(aHeader, aBody: String): String;
begin
  result := Data(Trim(aHeader) + #13#10#13#10 + aBody);
end;

{******************************************************************************}
Function TAlSmtpClient.Data(aHeader:TALSMTPClientHeader; aBody: String): String;
begin
  result := Data(aHeader.GetRawHeaderText, aBody);
end;

{*********************************************************************}
Function TAlSmtpClient.DataMultipartMixed(aHeader: TALSMTPClientHeader;
                                          aInlineText, aInlineTextContentType: String;
                                          aAttachments: TALMultiPartMixedAttachments): String;
Var aMultipartMixedEncoder: TALMultipartMixedEncoder;
    Str: String;
begin
  aMultipartMixedEncoder := TALMultipartMixedEncoder.create;
  try
    aMultipartMixedEncoder.Encode(
                                  aInlineText,
                                  aInlineTextContentType,
                                  aAttachments
                                 );
    with aMultipartMixedEncoder do begin
      aHeader.ContentType := TAlMultiPartMixedStream(ContentStream).TopHeaderContentType;
      TAlMultiPartMixedStream(ContentStream).CloseBoundary;
      SetLength(Str,ContentStream.size);
      ContentStream.Position := 0;
      ContentStream.Read(str[1],ContentStream.Size);
    end;
    Result := Data(aHeader.GetRawHeaderText, Str);
  finally
    aMultipartMixedEncoder.free;
  end;
end;

{**************************************************************}
{This command specifies that the receiver must send an OK reply,
 and then close the transmission channel. The receiver should not
 close the transmission channel until it receives and replies to
 a QUIT command (even if there was an error). The sender should not
 close the transmission channel until it send a QUIT command and
 receives the reply (even if there was an error response to a previous
 command). If the connection is closed prematurely the receiver should
 act as if a RSET command had been received (canceling any pending
 transaction, but not undoing any previously completed transaction),
 the sender should act as if the command or transaction in progress had
 received a temporary error (4xx).}
Function TAlSmtpClient.Quit: String;
begin
  Result := SendCmd('QUIT',[221]);
  Disconnect;
end;