Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission	Action
sendmail.dpr	26.32 KB	-rw-rw-rw-
sendmail.mes	6.81 KB	-rw-rw-rw-

Code Editor : sendmail.dpr

program sendmail;

{

<license.txt>

fake sendmail for windows

Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:

* Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

* Redistributions in binary form must reproduce the above copyright
      notice, this list of conditions and the following disclaimer in the
      documentation and/or other materials provided with the distribution.

* Neither the name of the glob nor the names of its contributors may
      be used to endorse or promote products derived from this software
      without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

</license.txt>

<ChangeLog.txt>

version 32 (18 june 2011)
    - fix handling of invalid recipients

version 31 (15 sep, 2010)
    - fix encoding of 8-bit data

version 30 (30 aug, 2010)
    - update to latest indy version (fixes many issues)
    - add about/version

version 29 (sep 8, 2009)
    - fix for another indy 10 "range check error" (when using ssl)

version 28 (aug 12, 2009)
    - set ERRORLEVEL to -1 to assist php

version 27 (aug 3, 2009)
    - don't treat log write errors as fatal

version 26 (apr 1, 2009)
    - no longer require -t parameter
    - skip first line if it starts with "from " (mail spool delimiting line)

version 25 (mar 29, 2009)
    - added force_recipient

version 24 (dec 2, 2008)
    - fixes for ssl

version 23 (apr 24, 2008)
    - fix timezone in date header

version 22 (jan 14, 2008)
    - fixes to error handling

version 21 (jan 2, 2008)
    - added TLS support

version 20 (apr 3, 2007)
    - fixed race condition in IIS's pickup delivery

version 19 (jul 24, 2006)
    - added support for delivery via IIS's pickup directory
    - optionally reads settings from the registry (in absense of the ini file)

version 18 (may 1, 2006)
    - fix for indy 10 "range check error"

version 17 (nov 2, 2005)
    - only process message header
    - optionally use madexcept for detailed crash dumps

version 16 (sep 12, 2005)
    - send hostname and domain with HELO/EHLO
    - configurable HELO/EHLO hostname
    - upgraded to indy 10

version 15 (aug 23, 2005)
    - fixes error messages when debug_logfile is not specified

version 14 (jun 28, 2005)
    - errors output to STDERR
    - fixes for delphi 7 compilation
    - added 'connecting to..' debug logging
    - reworked error and debug log format

version 13 (jun 8, 2005)
    - added fix to work around invalid multiple header instances

version 12 (apr 30, 2005)
    - added cc and bcc support

version 11 (feb 17, 2005)
    - added pop3 support (for pop before smtp authentication)

version 10 (feb 11, 2005)
    - added support for specifying a different smtp port

version 9 (sep 22, 2004)
    - added force_sender

version 8 (sep 22, 2004)
    - *really* fixes broken smtp auth

version 7 (sep 22, 2004)
    - fixes broken smtp auth

version 6 (sep 22, 2004)
    - correctly quotes MAIL FROM and RCPT TO addresses in &lt;&gt;

version 5 (sep 16, 2004)
    - now sends the message unchanged (rather than getting indy
      to regenerate it)

version 4 (aug 17, 2004)
    - added debug_logfile parameter
    - improved error messages

version 3 (jul 15, 2004)
    - smtp authentication support
    - clearer error message when missing from or to address
    - optional error logging
    - adds date: if missing

version 2 (jul 6, 2004)
    - reads default domain from registry (.ini setting overrides)

version 1 (jul 1, 2004)
    - initial release

</ChangeLog.txt>

requires indy 10.2 or higher
  i use a Tiburon branch svn pull
  https://svn.atozed.com:444/svn/Indy10/branches/Tiburon

http://www.indyproject.org/Sockets/Docs/Indy10Installation.EN.aspx

}

{$APPTYPE CONSOLE}

{$I IdCompilerDefines.inc}
{$IFNDEF INDY100}indy version 10 is required; built against 10_5_6{$ENDIF}

{$DEFINE USE_MADEXCEPT}

uses
  Windows, Classes, SysUtils, Registry, IniFiles,
  IdGlobal, IdResourceStringsCore, IdGlobalProtocols, IdResourceStrings, IdExplicitTLSClientServerBase,
  IDSmtp, IDPOP3, IdMessage, IdEmailAddress, IdLogFile, IdWinSock2, IdIOHandler, IdSSLOpenSSL, IdException
  {$IFDEF USE_MADEXCEPT}
  , madExcept, madLinkDisAsm, madListHardware, madListProcesses, madListModules
  {$ENDIF}
  ;

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

const
  VERSION = '32';

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

function buildLogLine(data, prefix: string) : string;
// ensure the output of error and debug logs are in the same format, regardless of source
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;

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

type

// TidLogFile using buildLogLine function

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;
  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;

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

var
  errorLogFile: string;
  debugLogFile: string;
  debug       : TlogFile;

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

procedure writeToLog(const logFilename, logMessage: string; const prefix: string = '');
var
  f: TextFile;
begin
  AssignFile(f, logFilename);
  try

if (not FileExists(logFilename)) then
    begin
      ForceDirectories(ExtractFilePath(logFilename));
      Rewrite(f);
    end
    else
      Append(f);

write(f, buildLogLine(logMessage, prefix));
    closeFile(f);

except
    on e:Exception do
      writeln(ErrOutput, 'sendmail: Error writing to ' + logFilename + ': ' + logMessage);
  end;
end;

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

procedure debugLog(const logMessage: string);
begin
  if (debug <> nil) and (debug.Active) then
    debug.LogWriteString(buildLogLine(logMessage, '**'))
  else if (debugLogFile <> '') then
    writeToLog(debugLogFile, logMessage, '**');
end;

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

procedure errorLog(const logMessage: string);
begin
  if (errorLogFile <> '') then
    writeToLog(errorLogFile, logMessage, ':');
  debugLog(logMessage);
end;

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

function appendDomain(const address, domain: string): string;
begin
  Result := address;
  if (Pos('@', address) <> 0) then
    Exit;
  Result := Result + '@' + domain;
end;

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

function joinMultiple(const messageContent: string; fieldName: string): string;
// the rfc says that some fields are only allowed once in a message header
// for example, to, from, subject
// this function joins multiple instances of the specified field into a single comma seperated line
var
  sl    : TstringList;
  i     : integer;
  s     : string;
  n     : integer;
  count : integer;
  values: TstringList;
begin

fieldName := LowerCase(fieldName);
  sl := TStringList.Create;
  values := TStringList.Create;
  try

sl.text := messageContent;
    result := '';

// only modify the header if there's more than one instance of the field

count := 0;
    for i := 0 to sl.count - 1 do
    begin
      s := sl[i];
      if (s = '') then
        break;
      n := pos(':', s);
      if (n = 0) then
        break;
      if (lowerCase(copy(s, 1, n - 1)) = fieldName) then
        inc(count);
    end;

if (count <= 1) then
    begin
      result := messageContent;
      exit;
    end;

// more than on instance of the field, combine into single entry, ignore fields with empty values

while (sl.count > 0) do
    begin
      s := sl[0];
      if (s = '') then
        break;
      n := pos(':', s);
      if (n = 0) then
        break;

if (lowerCase(copy(s, 1, n - 1)) = fieldName) then
      begin
        s := trim(copy(s, n + 1, length(s)));
        if (s <> '') then
          values.Add(s);
      end
      else
        result := result + s + #13#10;

sl.Delete(0);
    end;

if (values.count <> 0) then
    begin
      s := UpCaseFirst(fieldName) + ': ';
      for i := 0 to values.count - 1 do
        s := s + values[i] + ', ';
      setLength(s, length(s) - 2);
      result := result + s + #13#10;
    end;

result := result + sl.Text;

finally
    values.Free;
    sl.free;
  end;

end;

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

function DateTimeToInternetStr(const Value: TDateTime): string;
var
  day  : word;
  month: word;
  year : word;
begin
  DecodeDate(Value, year, month, day);
  Result := Format(
    '%s, %d %s %d %s %s',
    [
      wdays[DayOfWeek(Value)],
      day,
      monthnames[month],
      year,
      FormatDateTime('HH":"mm":"ss', Value),
      UTCOffsetToStr(OffsetFromUTC, false)
    ]
  );
end;

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

{$IFDEF USE_MADEXCEPT}
procedure madExceptionHandler(const exceptIntf: IMEException; var handled: boolean);
var
  path: string;
  i   : integer;
  fs  : TFileStream;
  s   : string;
begin
  handled := true;

path := extractFilePath(debugLogFile);

deleteFile(path + 'crash-5.txt');
  for i := 4 downto 1 do
  if (fileExists(path + 'crash-' + intToStr(i) + '.txt')) then
    RenameFile(path + 'crash-'+ intToStr(i) + '.txt', path + 'crash-' + intToStr(i + 1) + '.txt');
  if (fileExists(path + 'crash.txt')) then
    RenameFile(path + 'crash.txt', path + 'crash-1.txt');

fs := TFileStream.Create(path + 'crash.txt', fmCreate);
  try
    s := exceptIntf.GetBugReport;
    fs.Write(s[1], length(s));
  finally
    fs.free;
  end;

ExitProcess(DWORD(-1));
end;
{$ENDIF}

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

var

smtpServer    : string;
  smtpPort      : string;
  smtpSSL       : (ssAuto, ssSSL, ssTLS, ssNone);
  defaultDomain : string;
  messageContent: string;
  authUsername  : string;
  authPassword  : string;
  forceSender   : string;
  forceRcpt     : string;
  pop3server    : string;
  pop3username  : string;
  pop3password  : string;
  hostname      : string;
  isPickup      : boolean;

reg : TRegistry;
  ini : TCustomIniFile;
  pop3: TIdPop3;
  smtp: TIdSmtp;

i     : integer;
  s     : string;
  ss    : TStringStream;
  msg   : TIdMessage;
  sl    : TStringList;
  header: boolean;
  fs    : TFileStream;

validRecipientCount: integer;

begin

// command line help

if (ParamStr(1) = '-h') then
  begin
    writeln('fake sendmail version ' + VERSION);
    writeln('http://glob.com.au/sendmail');
    halt(1);
  end;

// read default domain from registry

reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if (reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters')) then
      defaultDomain := reg.ReadString('Domain');
  finally
    reg.Free;
  end;

// read ini

s := ChangeFileExt(ParamStr(0), '.ini');
  if (FileExists(s)) then
    ini := TIniFile.Create(s)
  else
  begin
    ini := TRegistryIniFile.Create('\software');
    TRegistryIniFile(ini).RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
    TRegistryIniFile(ini).RegIniFile.OpenKey(TRegistryIniFile(ini).FileName, true);
  end;

try

smtpServer    := ini.ReadString('sendmail', 'smtp_server',     'mail.mydomain.com');
    smtpPort      := ini.ReadString('sendmail', 'smtp_port',       '25');
    defaultDomain := ini.ReadString('sendmail', 'default_domain',  defaultDomain);
    hostname      := ini.ReadString('sendmail', 'hostname',        '');
    errorLogFile  := ini.ReadString('sendmail', 'error_logfile',   '');
    debugLogFile  := ini.ReadString('sendmail', 'debug_logfile',   '');
    authUsername  := ini.ReadString('sendmail', 'auth_username',   '');
    authPassword  := ini.ReadString('sendmail', 'auth_password',   '');
    forceSender   := ini.ReadString('sendmail', 'force_sender',    '');
    forceRcpt     := ini.ReadString('sendmail', 'force_recipient', '');
    pop3server    := ini.ReadString('sendmail', 'pop3_server',     '');
    pop3username  := ini.ReadString('sendmail', 'pop3_username',   '');
    pop3password  := ini.ReadString('sendmail', 'pop3_password',   '');

s := LowerCase(ini.ReadString('sendmail', 'smtp_ssl', 'auto'));
    if (s = 'ssl') then
      smtpSSL := ssSSL
    else if (s = 'tls') then
      smtpSSL := ssTLS
    else if (s = 'none') then
      smtpSSL := ssNone
    else
      smtpSSL := ssAuto;

if (smtpServer = 'mail.mydomain.com') or (defaultDomain = 'mydomain.com') then
    begin
      writeln(ErrOutput, 'You must configure the smtp_server and default_domain in:');
      writeln(ErrOutput, '  ' + ini.fileName);
      writeln(ErrOutput, '  or');
      writeln(ErrOutput, '  HKLM\Software\Sendmail');
      ExitProcess(DWORD(-1));
    end;

finally
    ini.Free;
  end;

if (errorLogFile <> '') and (ExtractFilePath(errorLogFile) = '') then
    errorLogFile := ExtractFilePath(ParamStr(0)) + errorLogFile;

if (debugLogFile <> '') and (ExtractFilePath(debugLogFile) = '') then
    debugLogFile := ExtractFilePath(ParamStr(0)) + debugLogFile;

isPickup := DirectoryExists(smtpServer);
  if (isPickup) then
    smtpServer := IncludeTrailingPathDelimiter(smtpServer);

s := ParamStr(1);
  if (s <> '') and (s[1] <> '-') and (FileExists(s)) then
  begin

// read email from file

fs := TFileStream.Create(ParamStr(1), fmOpenRead + fmShareDenyWrite);
    try
      setLength(messageContent, fs.Size);
      fs.Read(messageContent[1], length(messageContent));
    finally
      fs.Free;
    end;

end
  else
  begin

// read email from stdin

messageContent := '';
    while (not eof(Input)) do
    begin
      readln(Input, s);
      if (messageContent = '') and (copy(s, 1, 5) = 'From ') then
        continue;
      messageContent := messageContent + s + #13#10;
    end;

end;

// make sure message is CRLF delimited

if (pos(#10, messageContent) = 0) then
    messageContent := stringReplace(messageContent, #13, #13#10, [rfReplaceAll]);

if (debugLogFile <> '') then
  begin
    debugLog('--- MESSAGE BEGIN ---');
    sl := TStringList.Create;
    try
      sl.Text := messageContent;
      for i := 0 to sl.Count - 1 do
        debugLog(sl[i]);
    finally
      sl.Free;
    end;
    debugLog('--- MESSAGE END ---');
  end;

// fix multiple to, cc, bcc and subject fields

messageContent := joinMultiple(messageContent, 'to');
  messageContent := joinMultiple(messageContent, 'cc');
  messageContent := joinMultiple(messageContent, 'bcc');
  messageContent := joinMultiple(messageContent, 'subject');

// deliver message

{$IFDEF USE_MADEXCEPT}
  RegisterExceptionHandler(madExceptionHandler, stTrySyncCallAlways);
  {$ENDIF}

try

if (isPickup) then
    begin

// drop to IIS's pickup directory

ForceDirectories(smtpServer + 'Temp');

// generate filename (in the temp directory)

setLength(s, MAX_PATH);
      if (GetTempFileName(pChar(smtpServer + 'Temp'), 'sm', 0, @s[1]) = 0) then
        RaiseLastOSError;
      s := strPas(pChar(s));

// write

fs := TFileStream.Create(s, fmCreate);
      try
        fs.Write(messageContent[1], length(messageContent));
      finally
        fs.free;
      end;

// move into the real pickup directory

if (not RenameFile(s, smtpServer + ChangeFileExt(ExtractFileName(s), '.eml'))) then
        RaiseLastOSError;

RemoveDir(smtpServer + 'Temp');

end
    else
    begin

// deliver via smtp

// load message into stream

ss  := TStringStream.Create(messageContent);
      msg := nil;

try

// load message

msg := TIdMessage.Create(nil);
        try
          msg.LoadFromStream(ss, true);
        except
          on e:exception do
            raise exception.create('Failed to read email message: ' + e.message);
        end;

// check for from and to

if (forceSender = '') and (Msg.From.Address = '') then
          raise Exception.Create('Message is missing sender''s address');
        if (forceRcpt = '') and (Msg.Recipients.Count = 0) and (Msg.CCList.Count = 0) and (Msg.BccList.Count = 0) then
          raise Exception.Create('Message is missing recipient''s address');

if (debugLogFile <> '') then
        begin
          try
            debug          := TlogFile.Create(nil);
            debug.FileName := debugLogFile;
            debug.Active   := True;
          except
            // silently ignore
            debug := nil;
          end;
        end
        else
          debug := nil;

if ((pop3server <> '') and (pop3username <> '')) then
        begin

// pop3 before smtp auth

debugLog('Authenticating with POP3 server');

pop3 := TIdPOP3.Create(nil);
          try
            if (debug <> nil) then
            begin
              pop3.IOHandler           := TIdIOHandler.MakeDefaultIOHandler(pop3);
              pop3.IOHandler.Intercept := debug;
              pop3.IOHandler.OnStatus  := pop3.OnStatus;
              pop3.ManagedIOHandler    := True;
            end;
            pop3.Host           := pop3server;
            pop3.Username       := pop3username;
            pop3.Password       := pop3password;
            pop3.ConnectTimeout := 10 * 1000;
            pop3.Connect;
            pop3.Disconnect;
          finally
            pop3.free;
          end;

end;

smtp := TIdSMTP.Create(nil);
        try

// if openSSL libraries are available, use SSL for TLS support

smtp.IOHandler := nil;
          smtp.ManagedIOHandler := True;

if (smtpSSL <> ssNone) then
          begin
            try
              TIdSSLContext.Create.Free;
              smtp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(smtp);

if (smtpSSL = ssAuto) then
                if (strToIntDef(smtpPort, 25) = 465) then
                  smtpSSL := ssSSL
                else
                  smtpSSL := ssTLS;

if (smtpSSL = ssSSL) then
                smtp.UseTLS := utUseImplicitTLS
              else
                smtp.UseTLS := utUseExplicitTLS;
            except
              on e:exception do
              begin
                debugLog('Failed to load SSL libraries: ' + e.message);
                smtp.IOHandler := nil;
              end;
            end;
          end;

if (smtp.IOHandler = nil) then
          begin
            smtp.IOHandler := TIdIOHandler.MakeDefaultIOHandler(smtp);
            smtp.UseTLS := utNoTLSSupport;
          end;

if (debug <> nil) then
          begin
            smtp.IOHandler.Intercept := debug;
            smtp.IOHandler.OnStatus  := smtp.OnStatus;
          end;

// set host, port

i := pos(':', smtpServer);
          if (i = 0) then
          begin
            smtp.host := smtpServer;
            smtp.port := strToIntDef(smtpPort, 25);
          end
          else
          begin
            smtp.host := copy(smtpServer, 1, i - 1);
            smtp.port := strToIntDef(copy(smtpServer, i + 1, length(smtpServer)), 25);
          end;

// set hostname (for helo/ehlo)

if (hostname = '') then
          begin
            setLength(hostname, 255);
            GetHostName(pChar(hostname), length(hostname));
            hostname := string(pChar(hostname));
            if (pos('.', hostname) = 0) and (defaultDomain <> '') then
              hostname := hostname + '.' + defaultDomain;
          end;
          smtp.HeloName := hostname;

// connect to server

debugLog('Connecting to ' + smtp.Host + ':' + intToStr(smtp.Port));

smtp.ConnectTimeout := 10 * 1000;
          smtp.Connect;

// set up authentication

if (authUsername <> '') then
          begin
            debugLog('Authenticating as ' + authUsername);
            smtp.AuthType := satDefault;
            smtp.Username := authUsername;
            smtp.Password := authPassword;
          end;

// authenticate and start tls

smtp.Authenticate;

// sender and recipients

validRecipientCount := 0;
          
          if (forceSender = '') then
            smtp.SendCmd('MAIL FROM: <' + appendDomain(Msg.From.Address, defaultDomain) + '>', [250])
          else
            smtp.SendCmd('MAIL FROM: <' + appendDomain(forceSender, defaultDomain) + '>', [250]);

if (forceRcpt = '') then
          begin
            for i := 0 to msg.Recipients.Count - 1 do
              if (smtp.SendCmd('RCPT TO: <' + appendDomain(Msg.Recipients[i].Address, defaultDomain) + '>', [250, 550]) = 250) then
                inc(validRecipientCount)
              else
                errorLog('Invalid recipient <' + appendDomain(Msg.Recipients[i].Address, defaultDomain) + '>');

for i := 0 to msg.ccList.Count - 1 do
              if (smtp.SendCmd('RCPT TO: <' + appendDomain(Msg.ccList[i].Address, defaultDomain) + '>', [250, 550]) = 250) then
                inc(validRecipientCount)
              else
                errorLog('Invalid recipient <' + appendDomain(Msg.ccList[i].Address, defaultDomain) + '>');

for i := 0 to msg.BccList.Count - 1 do
              if (smtp.SendCmd('RCPT TO: <' + appendDomain(Msg.BccList[i].Address, defaultDomain) + '>', [250, 550]) = 250) then
                inc(validRecipientCount)
              else
                errorLog('Invalid recipient <' + appendDomain(Msg.BccList[i].Address, defaultDomain) + '>');
          end
          else
            if (smtp.SendCmd('RCPT TO: <' + appendDomain(forceRcpt, defaultDomain) + '>', [250, 550]) = 250) then
              inc(validRecipientCount)
            else
              errorLog('Invalid recipient <' + appendDomain(forceRcpt, defaultDomain) + '>');

if (validRecipientCount = 0) then
            raise Exception.Create('No valid recipients were found');

// start message content

smtp.SendCmd('DATA', [354]);

// add date header if missing

if (Msg.Headers.Values['date'] = '') then
            smtp.IOHandler.WriteLn('Date: ' + DateTimeToInternetStr(Now));

// send message line by line

sl := TStringList.Create;
          try
            sl.Text := messageContent;
            header  := true;
            for i := 0 to sl.Count - 1 do
            begin
              if (i = 0) and (sl[i] = '') then
                continue;
              if (sl[i] = '') then
                header := false;
              if (header) and (LowerCase(copy(sl[i], 1, 5)) = 'bcc: ') then
                continue;
              smtp.IOHandler.WriteLn(sl[i], TIdTextEncoding.Default);
            end;
          finally
            sl.Free;
          end;

// done

smtp.SendCmd('.', [250]);
          try
            smtp.SendCmd('QUIT');
          except
            on e:EIdConnClosedGracefully do
              ;// ignore
            on e:Exception do
              raise;
          end;

finally

if (smtp.Connected) then
            debugLog('Disconnecting from ' + smtp.Host + ':' + intToStr(smtp.Port));

smtp.Free;
        end;

finally
        msg.Free;
        ss.Free;
      end;

end;

except
    on e:Exception do
    begin
      writeln(ErrOutput, 'sendmail: Error during delivery: ' + e.message);
      errorLog(e.Message);
      {$IFDEF USE_MADEXCEPT}
      raise;
      {$ELSE}
      ExitProcess(DWORD(-1));
      {$ENDIF}
    end;
  end;

end.

${this.title}

Code Editor : sendmail.dpr