alsmtpclient.pas

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

{**********************************}
{This command asks the receiver to confirm that the argument identifies a user.
 If it is a user name, the full name of the user (if known) and the fully
 specified mailbox are returned. This command has no effect on any of the
 reverse-path buffer, the forward-path buffer, or the mail data buffer.}
Function TAlSmtpClient.Vrfy(aUserName: String): String;
begin
  Result := SendCmd('VRFY ' + aUserName,[250]);
end;

{*************************************************************}
{This command specifies that the current mail transaction is to
 be aborted. Any stored sender, recipients, and mail data must be
 discarded, and all buffers and state tables cleared. The receiver
 must send an OK reply.}
Function TAlSmtpClient.Rset: String;
begin
  Result := SendCmd('RSET',[250]);
end;

{*********************************************}
procedure TAlSmtpClient.SendMail(aHost: String;
                                 APort: integer;
                                 aFromName: String;
                                 aRcptNameLst: Tstrings;
                                 AUserName, APassword: String;
                                 aAuthType: TalSmtpClientAuthType;
                                 aMailData: String);
begin
  If Fconnected then Disconnect;

  connect(aHost,APort);
  Try

    If aAuthType = AlsmtpClientAuthAutoSelect then ehlo
    else Helo;
    If aAuthType <> AlsmtpClientAuthNone then Auth(AUserName, APassword, aAuthType);
    mailFrom(aFromName);
    RcptTo(aRcptNameLst);
    Data(aMailData);
    Quit;

  Finally
    Disconnect;
  end;
end;

{*********************************************}
procedure TAlSmtpClient.SendMail(aHost: String;
                                 APort: integer;
                                 aFromName: String;
                                 aRcptNameLst: Tstrings;
                                 AUserName, APassword: String;
                                 aAuthType: TalSmtpClientAuthType;
                                 aHeader, aBody: String);
begin
  If Fconnected then Disconnect;

  connect(aHost,APort);
  Try

    If aAuthType = AlsmtpClientAuthAutoSelect then ehlo
    else Helo;
    If aAuthType <> AlsmtpClientAuthNone then Auth(AUserName, APassword, aAuthType);
    mailFrom(aFromName);
    RcptTo(aRcptNameLst);
    Data(aHeader, aBody);
    Quit;

  Finally
    Disconnect;
  end;
end;

{***********************************************************}
procedure TAlSmtpClient.SendMailMultipartMixed(aHost: String;
                                               APort: integer;
                                               aFromName: String;
                                               aRcptNameLst: Tstrings;
                                               AUserName, APassword: String;
                                               aAuthType: TalSmtpClientAuthType;
                                               aHeader: TALSMTPClientHeader;
                                               aInlineText, aInlineTextContentType: String;
                                               aAttachments: TALMultiPartMixedAttachments);
begin
  If Fconnected then Disconnect;

  connect(aHost,APort);
  Try

    If aAuthType = AlsmtpClientAuthAutoSelect then ehlo
    else Helo;
    If aAuthType <> AlsmtpClientAuthNone then Auth(AUserName, APassword, aAuthType);
    mailFrom(aFromName);
    RcptTo(aRcptNameLst);
    DataMultipartMixed(
                       aHeader,
                       aInlineText,
                       aInlineTextContentType,
                       aAttachments
                      );
    Quit;

  Finally
    Disconnect;
  end;
end;

{*******************************************************************************}
{commands consist of a command code followed by an argument field. Command codes
 are four alphabetic characters. Upper and lower case alphabetic characters are
 to be treated identically. Thus, any of the following may represent the mail command:
            MAIL    Mail    mail    MaIl    mAIl
 This also applies to any symbols representing parameter values, such as "TO" or "to"
 for the forward-path. Command codes and the argument fields are separated by one or
 more spaces. However, within the reverse-path and forward-path arguments case is
 important. In particular, in some hosts the user "smith" is different from the user
 "Smith". The argument field consists of a variable length character string ending
 with the character sequence <CRLF>. The receiver is to take no action until
 this sequence is received. Square brackets denote an optional argument field.
 If the option is not taken, the appropriate default is implied.
 The following are the SMTP commands:
            HELO <SP> <domain> <CRLF>
            MAIL <SP> FROM:<reverse-path> <CRLF>
            RCPT <SP> TO:<forward-path> <CRLF>
            DATA <CRLF>
            RSET <CRLF>
            SEND <SP> FROM:<reverse-path> <CRLF>
            SOML <SP> FROM:<reverse-path> <CRLF>
            SAML <SP> FROM:<reverse-path> <CRLF>
            VRFY <SP> <string> <CRLF>
            EXPN <SP> <string> <CRLF>
            HELP [<SP> <string>] <CRLF>
            NOOP <CRLF>
            QUIT <CRLF>
            TURN <CRLF>}
function TAlSmtpClient.SendCmd(aCmd: String; OkResponses: array of Word): String;
Var P: Pchar;
    L: Integer;
    ByteSent: integer;
begin
  If (length(aCmd) <= 1) or
     (aCmd[length(aCmd)] <> #10) or
     (aCmd[length(aCmd) - 1] <> #13)
  then aCmd := aCmd + #13#10;

  p:=@aCmd[1]; // pchar
  l:=length(aCmd);
  while l>0 do begin
    ByteSent:=SocketWrite(p^,l);
    if ByteSent<=0 then raise Exception.Create('Connection close gracefully!');
    inc(p,ByteSent);
    dec(l,ByteSent);
  end;

  Result := GetResponse(OkResponses);
end;

{*********************************************************************}
{An SMTP reply consists of a three digit number (transmitted as three
 alphanumeric characters) followed by some text. The number is intended
 for use by automata to determine what state to enter next; the text is
 meant for the human user. It is intended that the three digits contain
 enough encoded information that the sender-SMTP need not examine the
 text and may either discard it or pass it on to the user, as appropriate.
 In particular, the text may be receiver-dependent and context dependent,
 so there are likely to be varying texts for each reply code. Formally,
 a reply is defined to be the sequence:
 a three-digit code, <SP>, one line of text, and <CRLF>, or a multiline reply.
 Only the EXPN and HELP commands are expected to result in multiline replies
 in normal circumstances, however multiline replies are allowed for any
 command.}
function TAlSmtpClient.GetResponse(OkResponses: array of Word): String;

  {----------------------------------------------}
  function Internalstpblk(PValue : PChar) : PChar;
  begin
    Result := PValue;
    while Result^ in [' ', #9, #10, #13] do Inc(Result);
  end;

  {---------------------------------------------------------------------}
  function InternalGetInteger(Data: PChar; var Number : Integer) : PChar;
  var bSign : Boolean;
  begin
    Number := 0;
    Result := InternalStpBlk(Data);
    if (Result = nil) then Exit;
    { Remember the sign }
    if Result^ in ['-', '+'] then begin
      bSign := (Result^ = '-');
      Inc(Result);
    end
    else bSign  := FALSE;
    { Convert any number }
    while (Result^ <> #0) and (Result^ in ['0'..'9']) do begin
      Number := Number * 10 + ord(Result^) - ord('0');
      Inc(Result);
    end;
    { Correct for sign }
    if bSign then Number := -Number;
  end;

Var aBuffStr: String;
    aBuffStrLength: Integer;
    aResponse: String;
    aStatusCode: Integer;
    aGoodResponse: Boolean;
    ALst : TstringList;
    P: Pchar;
    i, j: integer;
begin
  Result := '';
  While true do begin

    {Read the response from the socket - end of the response is show by <CRLF>}
    aResponse := '';
    While True do begin
      Setlength(aBuffStr,512); //The maximum total length of a reply line including the reply code and the <CRLF> is 512 characters. (http://www.freesoft.org/CIE/RFC/821/24.htm)
      aBuffStrLength := SocketRead(aBuffStr[1], length(aBuffStr));
      aResponse := AResponse + AlCopyStr(aBuffStr,1,aBuffStrLength);
      If aResponse = '' then raise Exception.Create('Connection close gracefully!');
      If (aBuffStrLength > 1) and
         (aBuffStr[aBuffStrLength] = #10) and
         (aBuffStr[aBuffStrLength - 1] = #13) then Break;
    end;
    Result := Result + aResponse;

    {The format for multiline replies requires that every line, except the last,
     begin with the reply code, followed immediately by a hyphen, "-" (also known as minus),
     followed by text. The last line will begin with the reply code, followed immediately
     by <SP>, optionally some text, and <CRLF>.}
    ALst := TstringList.create;
    Try
      Alst.Text := aResponse;
      If Alst.count = 0 then raise exception.Create('Emtpy response');
      For j := 0 to Alst.count - 1 do begin
        aResponse := Alst[j];
        p := InternalGetInteger(@aResponse[1], aStatusCode);
        aGoodResponse := False;
        for I := 0 to High(OkResponses) do
          if OkResponses[I] = aStatusCode then begin
            aGoodResponse := True;
            Break;
          end;

        If not aGoodResponse then Raise Exception.Create(aResponse);
        if p^ <> '-' then Begin
          If J <> Alst.count - 1 then Raise Exception.Create(aResponse);
          Exit;
        end;
      end;
    Finally
      ALst.Free;
    end;

  end;
end;

{**********************************************************************}
Function TAlSmtpClient.SocketWrite(Var Buffer; Count: Longint): Longint;
begin
  Result := Send(FSocketDescriptor,Buffer,Count,0);
  CheckError(Result =  SOCKET_ERROR);
end;

{*********************************************************************}
function TAlSmtpClient.SocketRead(var Buffer; Count: Longint): Longint;
begin
  Result := Recv(FSocketDescriptor,Buffer,Count,0);
  CheckError(Result = SOCKET_ERROR);
end;

{*******************************************************}
procedure TAlSmtpClient.Settimeout(const Value: integer);
begin
  If Value <> Ftimeout then begin
    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);
    Ftimeout := Value;
  end;
end;

end.