SMTP Mail and Indy (again)

Having spent a lot of time recently working on a ping scanner using Indy, I noticed that there's a lot of questions still on using SMTP with Indy. Let me first say that I am not an Indy expert. I get along with it successfully but find I still have to research things frequently.

With the disclaimer out of the way, we can get to the offering. A while back I wrote a handy little unit to simply send a mail message with or without attachments and with or without providing authentication. It even has support for OpenSSL. I use this unit in a number of applications and have seen it successfully send hundreds of e-mails without issue. I recently added support for threaded message sending to take advantage of the multi-core system I'm now running on.

This code has had a few additions (like the logger) that I've gleaned over time from various newsgroup postings, but I didn't record the authors so let me credit the anonymous Internet authors who support Indy. It's really amazing how helpful Google can be when you're stuck. At any rate, here's the code for the mailer in the hopes that it will help someone else who is stuck dealing with SMTP.

unit MailIt;

{requires indy10 - the LATER VERSIONS}

interface

uses Classes, SysUtils, IdSMTP, IdLogFile;

type
  //this class encapsulates the "where to" and "what" portions of the message
  //basically, it sends the BODY, including the files in the FILES list, using the SUBJECT to every person on the SendTo, etc. list
  //SendTo, CCSendTo, and BccSendTo all take comma separated addresses (i.e, SendTo:='first@me.com,second@me.com';)
  TDestinationPart = class
                     SendTo    : string; //list of addresses
                     CCSendTo  : string;
                     BccSendTo : string;
                     ReturnAddy: string; //if this is blank, there will be no return receipt

                     Subject   : string;
                     Body      : string;
                     Files     : TStringList;

                     constructor Create(aSndTo, aCCSndTo, aBCCSndTo, aRtrnRcptAddy, aSubject, aBody:string; aFiles:TStringList);
                     destructor Free;
                     end;

  //this class encapsulates the "how do i get it there" and "who from" portion of the message
  //since this doesn't frequently change, you can use CreateFromFile and SaveToFile to create a template
  //   and save the typing every time you set it up
  TOriginPart = class
                AuthType : TIdSMTPAuthenticationType;
                FromAddy : string;
                UserName : string;
                Password : string;
                Server   : string;
                Port     : integer;
                Debug    : boolean;
                constructor Create(aAuthType:TIdSMTPAuthenticationType; aFromAddy, aUserName, aPassword, aServer: string; aPort:integer);
                constructor CreateFromFile(fn:string);
                procedure SaveToFile(fn:string);
                end;

  //this is the entire message
  //you provide a DestinationPart and OriginPart and send the file using SendNow.
  //   Check SentOk afterwards to make sure it went.
  //   Any error message will be in SendMsg
  TMailMessage = class
                 public
                 Destination : TDestinationPart;
                 Origin      : TOriginPart;
                 SentOk      : boolean;
                 SentMsg     : string;
                 logFile     : TIdLogFile;

                 constructor Create(Dest:TDestinationPart; Orig:TOriginPart);
                 procedure SendNow;
                 destructor Free;
                 end;

  //this REPLACES TMailMessage with a Threaded version.
  //You may want to use the FreeOnTerminate flag to create a "Fire and Forget" threaded solution
  //   NOTE: DO NOT GO CRAZY
  //         Pay attention to the documentation of the OS (try this for what I mean http://blogs.msdn.com/oldnewthing/archive/2005/07/29/444912.aspx)
  //         If you've got a really great quad-cpu quad-core rig, you may want to use a bigger number
  TThreadMailMessage = class(TThread)                           //you get no error results or other
                       protected                                //information from this class, it just tries to send the message in the
                          MailMsg : TMailMessage;               //background.make sure you use the debug function if you're having problems
                          procedure Execute; override;
                       public
                          constructor Create(aDestinationPart:TDestinationPart;
                                             aOriginPart:TOriginPart);
                       end;


//NOTE: The following utility entries use CriticalSections. DO NOT HAMMER THEM.

//You can test this to see if all the TThreadedMailMessages have completed
function MailThreadsDone:boolean;
//A count of the number of TThreadedMailMessages are still out there
function ActiveMailThreadCount:integer;

implementation

uses IdGlobal, IdResourceStringsCore, IdGlobalProtocols, IdResourceStrings, IdExplicitTLSClientServerBase,
    IDPOP3, IdMessage, IdEmailAddress, IdWinSock2, IdIOHandler, IdSSLOpenSSL, IdException,
    IdAttachmentFile, IdText, IdSASL_CRAM_MD5, IdUserPassProvider, IniFiles,
    IdIOHandlerStream, Dialogs, windows;

const
  logFileName='mailit.log'; //the default log file name

var
  ActiveMailThreads : integer=0;
  MailThreadCSR     : TRTLCriticalSection;

// ---------------------------------------------------------------------------

type
 // this is a descendant of TidLogFile, it will create a plain text file with
 // information about the transfer session
 TlogFile = class(TidLogFile)
 protected
   procedure LogReceivedData(const AText, AData: string); override;
   procedure LogSentData(const AText, AData: string); override;
   procedure LogStatus(const AText: string); override;
 public
   procedure LogWriteString(const AText: string); override;
   class function buildLogLine(data, prefix: string) : string;
 end;

// this ensures the output of error and debug logs are in the same format, regardless of source
class function TlogFile.buildLogLine(data, prefix: string) : string;
begin

 data := StringReplace(data, EOL, RSLogEOL, [rfReplaceAll]);
 data := StringReplace(data, CR,  RSLogCR,  [rfReplaceAll]);
 data := StringReplace(data, LF,  RSLogLF,  [rfReplaceAll]);

 result := FormatDateTime('yy/mm/dd hh:nn:ss', now) + ' ';
 if (prefix <> '') then
   result := result + prefix + ' ';
 result := result + data + EOL;
end;

// ---------------------------------------------------------------------------

procedure TlogFile.LogReceivedData(const AText, AData: string);
begin
 // ignore AText as it contains the date/time
 LogWriteString(buildLogLine(Adata, '<<'));
end;

// ---------------------------------------------------------------------------

procedure TlogFile.LogSentData(const AText, AData: string);
begin
 // ignore AText as it contains the date/time
 LogWriteString(buildLogLine(Adata, '>>'));
end;

// ---------------------------------------------------------------------------

procedure TlogFile.LogStatus(const AText: string);
begin
 LogWriteString(buildLogLine(AText, '**'));
end;

// ---------------------------------------------------------------------------

procedure TlogFile.LogWriteString(const AText: string);
begin
 // protected --> public
 inherited;
end;
                                                     
// ---------------------------------------------------------------------------



// ---------------------------------------------------------------------------
{TMailMessage}
// ---------------------------------------------------------------------------

constructor TMailMessage.Create(Dest:TDestinationPart; Orig:TOriginPart);
begin
Destination:=Dest;
Origin:=Orig;
//the class expects these, it will create them by default
if Destination=nil then Destination:=TDestinationPart.Create('','','','','','',TStringList.Create);
if Origin=nil      then Origin:=TOriginPart.Create(satDefault,'','','','',0);
end;

// ---------------------------------------------------------------------------
procedure TMailMessage.SendNow;
var MsgSend:TIdMessage;
   SMTP:TIdSMTP;
   ix:integer;
   SASLLogin:TIdSASLCramMD5;
   UserPassProv:TIdUserPassProvider;
   textPart:TIdText;
begin
  logFile := nil;                                                     //init to no logging
  MsgSend:=TIdMessage.Create;                                         //create the message
  with MsgSend do
     begin
        Body.Text:=Destination.Body;
        if POS('<html>',Body.Text)<>0 then
           if (Destination.Files<>nil) AND (Destination.Files.Count>0) then //if you are using attachments with html mail, you have do do it in sections
              begin
              Body.Text:='';                                          //clear the body
              contentType:='multipart/alternative';                   //setup the message parts
              textPart:=TIdText.Create(MsgSend.MessageParts,nil);     // this is for plain text
              textPart.ContentType:='text/plain';                     // set the content type
              textPart.Body.Add('This message is formatted as HTML.');// just tell the user that the message is html - it would be nice to strip the html, but you'd never make it look right. probably should add support for a plain text and html text in the Destination class
              textPart.Body.Add(Destination.Body);                    // add the plain text part which is really html formatted
              textPart:=TIdText.Create(MsgSend.MessageParts,nil);     // this is for html text (which is basically just plain text with special rules)
              textPart.ContentType:='text/html';                      // set the content type - this is the magic that kicks in the special rules
              textPart.Body.Add(Destination.Body);                    // add the html formatted text
              end
           else
              contentType:='text/html';                               //you can just send it as an html message
        From.Text := Origin.FromAddy;                                 //setup the from address
        Recipients.EMailAddresses := Destination.SendTo;              //setup who it's going to
        Subject := Destination.Subject;                               //set the subject
        Priority := mpNormal;                                         //set the priority (note that you could add to Destination to support different priorities)
        CCList.EMailAddresses := Destination.CCSendTo;                //set the CC list
        BccList.EMailAddresses := Destination.BCCSendTo;              //set the BCC list
        ReceiptRecipient.Text := Destination.ReturnAddy;              //set the return receipt address
     end;

  for ix:=0 to Destination.Files.Count-1 do                            //if we got a list of file names, add each file as an attachment
     TIdAttachmentFile.Create(MsgSend.MessageParts, Destination.Files.Strings[ix]);

  try
    SMTP:=TIdSMTP.Create;                                              //create the SMTP object

    try
      TIdSSLContext.Create.Free;                                       //try to create a SSL context (immediately disposes of it) - need OpenSSL to support this, if it fails, it will fall into the exception
      smtp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(smtp);     //if we succeed, then we can create a SSL socket handler and assign it to the IOHandler
      smtp.UseTLS := utUseExplicitTLS;                                 //and we can mark the we can use tls
    except
      smtp.IOHandler := TIdIOHandler.MakeDefaultIOHandler(smtp);       //the SSL failed to create, so make the default IO handler
      smtp.UseTLS := utNoTLSSupport;                                   //mark that we have no TLS support
    end;
    smtp.ManagedIOHandler := True;                                     //either way, we now have a ManagedIOHandler

    if Origin.Debug then                                               //if we marked that we wanted debugging, we need to do some setup
       begin
       logFile := TLogFile.Create(nil);                                //create the log file
       logFile.FileName:=logFileName;                                  //set the default log file name - NOTE: you could get fancy with this, but I normally don't use it
       logFile.Active:=true;                                           //activate the log file (creates the file and intializes everything)
       smtp.IOHandler.Intercept := logFile;                            //set the logFile to the intercept of the IOHandler to capture the events
       smtp.IOHandler.OnStatus  := smtp.OnStatus;                      // - not sure why we do this, copied code -
       end;

    try
      SMTP.AuthType := Origin.AuthType;                                //setup the auth type : satNONE, satDEFAULT, satSASL
      SMTP.UserName := Origin.UserName;                                //setup the user name
      SMTP.Password := Origin.Password;                                //setup the password

      userPassProv:=TIdUserPassProvider.Create;                        //create the user/pass provider - this handles the login functions for SASL
      userPassProv.UserName:=SMTP.UserName;                            // setup user name
      userPassProv.Password:=SMTP.Password;                            // & password

      if SMTP.AuthType=satSASL then                                    //if we are going to use SASL - basically, SASL just encrypts the login, everything else is still clear text
        begin
        SASLLogin:=TIdSASLCramMd5.Create;                              // create the CramMd5 provider - see http://en.wikipedia.org/wiki/CRAM-MD5 - this is the encryptor
        SASLLogin.UserPassProvider:=userPassProv;                      // assign the user pass provider to it
        SMTP.SASLMechanisms.Add.SASL:=SASLLogin;                       // add the SASL login back to the SMTP object
        end;

      {General setup}
      SMTP.Host := Origin.Server;                                      //setup the server name
      SMTP.Port := Origin.Port;                                        //setup the server port

      {now we send the message}
      SMTP.Connect;                                                    //connect to the server - this will automatically use TLS if configured and supported
      if not SMTP.Authenticate then                                    //authenticate with the server - this will automatically use SASL if configured and supported
         begin
         MessageDlg('An error occurred attempting to send your e-mail. The error was : Unable to authenticate.', mtError, [mbOK], 0);
         exit;
         end;
      try
         try
            SMTP.Send(MsgSend);                                        //send the message
            SentOk:=true;                                              //indicate success
         finally
            SMTP.Disconnect;                                           //disconnect from the server
         end;
      except on E :Exception do                                        //if we had a failure, say so
         begin
         MessageDlg('An error occurred attempting to send your e-mail. The error was : '+E.Message, mtError, [mbOK], 0);
         SentOk:=false;                                                //set failure
         SentMsg:=E.Message;                                           //and grab the error message
         end;
      end;
    finally
    SMTP.Free;                                                         //free the memory
    end;
  finally
     if logFile<>nil then                                              //if we had a log file, free that
        logFile.Free;
     MsgSend.Free;                                                     //free the message
  end;
end;

// ---------------------------------------------------------------------------
destructor TMailMessage.Free;
begin
Destination.Free;                                                      //free the destination
Origin.Free;                                                           //free the origin
end;

// ---------------------------------------------------------------------------


// ---------------------------------------------------------------------------
{TDestinationPart}
// ---------------------------------------------------------------------------

constructor TDestinationPart.Create(aSndTo, aCCSndTo, aBCCSndTo, aRtrnRcptAddy, aSubject, aBody:string; aFiles:TStringList);
begin
SendTo    := aSndTo;          //send message to, comma separate list for multiple adddesses
CCSendTo  := aCCSndTo;        //CC message to
BccSendTo := aBCCSndTo;       //BCC message to
ReturnAddy:= aRtrnRcptAddy;   //leave blank for not return receipt. set if you want a return receipt (me@mydomain.com)

Subject   := aSubject;        //what's it about
Body      := aBody;           //the text, supports HTML or TEXT
Files     := aFiles;          //a list of files to upload - WATCH THIS - you are giving up control by passing in the list, this list is free'd in the destructor
if Files=nil then
  Files:=TStringList.Create; //we must have a list, create if not provided
end;

// ---------------------------------------------------------------------------
destructor TDestinationPart.Free;
begin
Files.Free;                   //free space claimed in create - watch this, it takes control of the list passed in the create and will dispose of it, can cause A/Vs
end;

// ---------------------------------------------------------------------------

// ---------------------------------------------------------------------------
{TOriginPart}
// ---------------------------------------------------------------------------

constructor TOriginPart.Create(aAuthType:TIdSMTPAuthenticationType; aFromAddy, aUserName, aPassword, aServer: string; aPort:integer);
begin
AuthType := aAuthType;    //options are : 0=satNONE, 1=satDEFAULT, 2=satSASL
FromAddy := aFromAddy;    //me@mydomain.com
UserName := aUserName;    //me
Password := aPassword;    //mypassword
Server   := aServer;      //smtp.mydomain.com
Port     := aPort;        //SMTP connection port (25 is default)
Debug    := false;        //debugging off/on
end;

// ---------------------------------------------------------------------------
constructor TOriginPart.CreateFromFile(fn:string);
var INF:TIniFile;
   i:integer;
begin
INF:=TIniFile.Create(fn);
i        := INF.ReadInteger('SMTP','AuthType',ord(satDefault));
case i of
0 : AuthType := satNONE;
1 : AuthType := satDEFAULT;
2 : AuthType := satSASL;
end;
FromAddy := INF.ReadString ('SMTP', 'FromAddy', ''); //me@mydomain.com
UserName := INF.ReadString ('SMTP', 'UserName', ''); //me
Password := INF.ReadString ('SMTP', 'Password', ''); //mypassword
Server   := INF.ReadString ('SMTP', 'Server', '');   //smtp.mydomain.com
Port     := INF.ReadInteger('SMTP', 'Port', 25);     //default SMTP is 25
Debug    := INF.ReadBool   ('SMTP', 'Debug', false); //we don't we debugging on
INF.Free;
end;

// ---------------------------------------------------------------------------
procedure TOriginPart.SaveToFile(fn:string);
var INF:TIniFile;
begin
INF:=TIniFile.Create(fn);
INF.WriteInteger('SMTP', 'AuthType', ord(AuthType)); //options are : 0=satNONE, 1=satDEFAULT, 2=satSASL
INF.WriteString ('SMTP', 'FromAddy', FromAddy);      //me@mydomain.com
INF.WriteString ('SMTP', 'UserName', UserName);      //me
INF.WriteString ('SMTP', 'Password', Password);      //mypassword
INF.WriteString ('SMTP', 'Server',   Server);        //smtp.mydomain.com
INF.WriteInteger('SMTP', 'Port',     Port);          //SMTP connection port
INF.WriteBool   ('SMTP', 'Debug',    Debug);         //debugging off/on
INF.Free;
end;

// ---------------------------------------------------------------------------


// ---------------------------------------------------------------------------
{ TThreadMailMessage & util functions for it}
// ---------------------------------------------------------------------------

procedure IncMailThreadCount;
begin
  EnterCriticalSection(MailThreadCSR);
  inc(ActiveMailThreads);
  LeaveCriticalSection(MailThreadCSR);
end;

procedure DecMailThreadCount;
begin
  EnterCriticalSection(MailThreadCSR);
  dec(ActiveMailThreads);
  LeaveCriticalSection(MailThreadCSR);
end;

function MailThreadsDone:boolean;
begin
  result:=ActiveMailThreadCount=0;
end;

function ActiveMailThreadCount:integer;
begin
  EnterCriticalSection(MailThreadCSR);
  result:=ActiveMailThreads;
  LeaveCriticalSection(MailThreadCSR);
end;


constructor TThreadMailMessage.Create(aDestinationPart: TDestinationPart;
 aOriginPart: TOriginPart);
begin
inherited Create(false);
IncMailThreadCount;
if aDestinationPart=nil then raise Exception.Create('You must supply a destination');
if aOriginPart=nil      then raise Exception.Create('You must supply an origin');
FreeOnTerminate:=true;

MailMsg:=TMailMessage.Create(aDestinationPart, aOriginPart);
end;

procedure TThreadMailMessage.Execute;
begin
  try
     MailMsg.SendNow;
  finally
     DecMailThreadCount;
  end;
end;

initialization
  InitializeCriticalSection(MailThreadCSR);

finalization
  DeleteCriticalSection(MailThreadCSR);

end.