{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


Author:       François PIETTE
Object:       How to use TSslSmtpCli component
Creation:     09 october 1997
Version:      2.07
EMail:        http://www.overbyte.be        francois.piette@overbyte.be
Support:      Use the mailing list twsocket@elists.org
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1997-2003 by François PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
              <francois.piette@overbyte.be>
              SSL implementation includes code written by Arno Garrels,
              Berlin, Germany, contact: <arno.garrels@gmx.de>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

Updates:
Aug 20, 2003 SSL support added by Arno Garrels <arno.garrels@gmx.de>.
Dec 29, 2007 A. Garrels reworked SSL, simplified verification code.

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit SslMailSnd1;
{$IFDEF VER80}
    Bomb('This unit require a 32 bit compiler !');
{$ENDIF}
{$IFNDEF USE_SSL}
    Bomb('You need to define USE_SSL in the project-options');
{$ENDIF}

{$B-}           { Enable partial boolean evaluation   }
{$T-}           { Untyped pointers                    }
{$X+}           { Enable extended syntax              }

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IniFiles,  
  WSocket,
  IcsLogger,
  SmtpProt;

const
  SslSmtpTestVersion    = 1.00;
  CopyRight : String    = ' SslMailSnd (c) 1997-2006 F. Piette V1.00 ';
  WM_SSL_RECONNECT      = WM_USER + 1;

type
  TSslSmtpTestForm = class(TForm)
    MsgMemo: TMemo;
    DisplayMemo: TMemo;
    ToolsPanel: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Subject: TLabel;
    Label4: TLabel;
    HostEdit: TEdit;
    FromEdit: TEdit;
    ToEdit: TEdit;
    SubjectEdit: TEdit;
    SignOnEdit: TEdit;
    PortEdit: TEdit;
    Label5: TLabel;
    AttachPanel: TPanel;
    Label6: TLabel;
    FileAttachMemo: TMemo;
    InfoPanel: TPanel;
    Label7: TLabel;
    ClearDisplayButton: TButton;
    ConnectButton: TButton;
    HeloButton: TButton;
    MailFromButton: TButton;
    RcptToButton: TButton;
    DataButton: TButton;
    AbortButton: TButton;
    QuitButton: TButton;
    MailButton: TButton;
    OpenButton: TButton;
    Label8: TLabel;
    SslSmtpClient: TSslSmtpCli;
    Label9: TLabel;
    Label10: TLabel;
    UsernameEdit: TEdit;
    PasswordEdit: TEdit;
    AuthComboBox: TComboBox;
    PriorityComboBox: TComboBox;
    Label11: TLabel;
    EhloButton: TButton;
    AuthButton: TButton;
    Label12: TLabel;
    CcEdit: TEdit;
    Label13: TLabel;
    BccEdit: TEdit;
    AllInOneButton: TButton;
    TlsButton: TButton;
    VerifyPeerCheckBox: TCheckBox;
    SmtpSslModeCombobox: TComboBox;
    Label15: TLabel;
    KeyEdit: TEdit;
    CertEdit: TEdit;
    Label16: TLabel;
    Label17: TLabel;
    CaFileEdit: TEdit;
    CaPathEdit: TEdit;
    Label18: TLabel;
    Label19: TLabel;
    PassPhraseEdit: TEdit;
    Label21: TLabel;
    SslContext1: TSslContext;
    procedure FormCreate(Sender: TObject);
    procedure ClearDisplayButtonClick(Sender: TObject);
    procedure ConnectButtonClick(Sender: TObject);
    procedure SslSmtpClientRequestDone(Sender: TObject; RqType: TSmtpRequest;
      Error: Word);
    procedure HeloButtonClick(Sender: TObject);
    procedure MailFromButtonClick(Sender: TObject);
    procedure RcptToButtonClick(Sender: TObject);
    procedure DataButtonClick(Sender: TObject);
    procedure AbortButtonClick(Sender: TObject);
    procedure QuitButtonClick(Sender: TObject);
    procedure MailButtonClick(Sender: TObject);
    procedure OpenButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EhloButtonClick(Sender: TObject);
    procedure AuthButtonClick(Sender: TObject);
    procedure AllInOneButtonClick(Sender: TObject);
    procedure SmtpClientDisplay(Sender: TObject; Msg: String);
    procedure SslSmtpClientResponse(Sender: TObject; Msg: String);
    procedure SslSmtpClientCommand(Sender: TObject; Msg: String);
    procedure SslSmtpClientGetData(Sender: TObject; LineNum: Integer;
      MsgLine: Pointer; MaxLen: Integer; var More: Boolean);
    procedure SslSmtpClientHeaderLine(Sender: TObject; Msg: Pointer; Size: Integer);
    procedure SslSmtpClientBeforeFileOpen(Sender: TObject; Idx: Integer;
      FileName: String; var Action: TSmtpBeforeOpenFileAction);
    procedure TlsButtonClick(Sender: TObject);
    procedure SslSmtpClientSslVerifyPeer(Sender: TObject; var Ok: Integer;
      Cert: TX509Base);
    procedure SslSmtpClientSslHandshakeDone(Sender: TObject; ErrCode: Word;
      PeerCert: TX509Base; var Disconnect: Boolean);
  private
    FIniFileName  : String;
    FInitialized  : Boolean;
    FAllInOneFlag : Boolean;
    FEhloCount    : Integer;
    procedure WMSslReconnect(var Msg: TMessage); message WM_SSL_RECONNECT;
    procedure Display(const Msg : String);
    procedure ExceptionHandler(Sender: TObject; E: Exception);
  end;

var
  SslSmtpTestForm: TSslSmtpTestForm;

implementation

{$R *.DFM}
const
    SectionData         = 'Data';
    KeyHost             = 'HostName';
    KeyPort             = 'Port';
    KeyFrom             = 'From';
    KeyTo               = 'To';
    KeyCc               = 'Cc';
    KeyBcc              = 'Bcc';
    KeySubject          = 'Subject';
    KeySignOn           = 'SignOn';
    KeyUser             = 'UserName';
    KeyPass             = 'Password';
    KeyAuth             = 'Authentification';
    KeyPriority         = 'Priority';
    SectionWindow       = 'Window';
    KeyTop              = 'Top';
    KeyLeft             = 'Left';
    KeyWidth            = 'Width';
    KeyHeight           = 'Height';
    SectionFileAttach   = 'Files';
    KeyFileAttach       = 'File';
    SectionMsgMemo      = 'Message';
    KeyMsgMemo          = 'Msg';
    KeySmtpSslMode      = 'SmtpSslMode';
    KeySslVerifyPeer    = 'SslVerifyPeer';
    KeySslKey           = 'SslKey';
    KeySslCert          = 'SslCert';
    KeySslCAFile        = 'SslCaFile';
    KeySslCAPath        = 'SslCaPath';
    KeySslHostsAccepted = 'SslHostsAccepted';
    KeySslPassPhrase    = 'SslPassPhrase';

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure SaveStringsToIniFile(
    const IniFileName : String;
    const IniSection  : String;
    const IniKey      : String;
    Strings           : TStrings);
var
    IniFile : TIniFile;
    nItem   : Integer;
begin
    if (IniFileName = '') or (IniSection = '') or (IniKey = '') or
       (not Assigned(Strings)) then
        Exit;
    IniFile := TIniFile.Create(IniFileName);
    IniFile.EraseSection(IniSection);
    if Strings.Count <= 0 then
        IniFile.WriteString(IniSection, IniKey + 'EmptyFlag', 'Empty')
    else
        for nItem := 0 to Strings.Count - 1 do
            IniFile.WriteString(IniSection,
                                IniKey + IntToStr(nItem),
                                Strings.Strings[nItem]);
    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Return FALSE if non existant in IniFile                                   }
function LoadStringsFromIniFile(
    const IniFileName : String;
    const IniSection  : String;
    const IniKey      : String;
    Strings           : TStrings) : Boolean;
var
    IniFile : TIniFile;
    nItem   : Integer;
    I       : Integer;
    Buf     : String;
begin
    Result := TRUE;
    if (IniFileName = '') or (IniSection = '') or (IniKey = '') or
       (not Assigned(Strings)) then
        Exit;
    Strings.Clear;
    IniFile := TIniFile.Create(IniFileName);
    try
        if IniFile.ReadString(IniSection, IniKey + 'EmptyFlag', '') <> '' then
             Exit;
        IniFile.ReadSectionValues(IniSection, Strings);
    finally
        IniFile.Free;
    end;
    nItem := Strings.Count - 1;
    while nItem >= 0 do begin
        Buf := Strings.Strings[nItem];
        if CompareText(IniKey, Copy(Buf, 1, Length(IniKey))) <> 0 then
            Strings.Delete(nItem)
        else begin
            if not (Buf[Length(IniKey) + 1] in ['0'..'9']) then
                Strings.Delete(nItem)
            else begin
                I := Pos('=', Buf);
                Strings.Strings[nItem] := Copy(Buf, I + 1, Length(Buf));
            end;
        end;
        Dec(nItem);
    end;
    Result := (Strings.Count <> 0);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Display a message in display memo box, making sure we don't overflow it.  }
procedure TSslSmtpTestForm.Display(const Msg : String);
begin
    DisplayMemo.Lines.BeginUpdate;
    try
        if DisplayMemo.Lines.Count > 200 then begin
            { We preserve only 200 lines }
            while DisplayMemo.Lines.Count > 200 do
                DisplayMemo.Lines.Delete(0);
        end;
        DisplayMemo.Lines.Add(Msg);
    finally
        DisplayMemo.Lines.EndUpdate;
        { Makes last line visible }
        {$IFNDEF VER80}
        SendMessage(DisplayMemo.Handle, EM_SCROLLCARET, 0, 0);
        {$ENDIF}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.FormCreate(Sender: TObject);
begin
{$IFDEF DELPHI10}
    // BDS2006 has built-in memory leak detection and display
    ReportMemoryLeaksOnShutdown := (DebugHook <> 0);
{$ENDIF}
    //IsConsole := AllocConsole;
    Application.OnException := ExceptionHandler;
    DisplayMemo.Clear;
    FIniFileName := LowerCase(ExtractFileName(Application.ExeName));
    FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.FormShow(Sender: TObject);
var
    IniFile : TIniFile;
begin
    if not FInitialized then begin
        FInitialized := TRUE;
        IniFile := TIniFile.Create(FIniFileName);
        HostEdit.Text    := IniFile.ReadString(SectionData, KeyHost,
                                               'localhost');
        PortEdit.Text    := IniFile.ReadString(SectionData, KeyPort,
                                               'smtp');
        FromEdit.Text    := IniFile.ReadString(SectionData, KeyFrom,
                                               'first.last@company.com');
        ToEdit.Text      := IniFile.ReadString(SectionData, KeyTo,
                                               'john.doe@acme;tartempion@brol.fr');
        CcEdit.Text      := IniFile.ReadString(SectionData, KeyCc,
                                               '');
        BccEdit.Text     := IniFile.ReadString(SectionData, KeyBcc,
                                               'francois.piette@swing.be');
        SubjectEdit.Text := IniFile.ReadString(SectionData, KeySubject,
                                               'This is the message subject');
        SignOnEdit.Text  := IniFile.ReadString(SectionData, KeySignOn,
                                               'your name');
        UsernameEdit.Text :=  IniFile.ReadString(SectionData, KeyUser,
                                               'account name');
        PasswordEdit.Text :=  IniFile.ReadString(SectionData, KeyPass,
                                               'account password');
        AuthComboBox.ItemIndex :=  IniFile.ReadInteger(SectionData, KeyAuth, 0);
        SmtpSslModeCombobox.ItemIndex := IniFile.ReadInteger(SectionData, KeySmtpSslMode, 0);
        VerifyPeerCheckBox.Checked := IniFile.ReadBool(SectionData, KeySslVerifyPeer, False);
        KeyEdit.Text :=  IniFile.ReadString(SectionData, KeySslKey,
                                               '01key.pem');
        PassPhraseEdit.Text := IniFile.ReadString(SectionData, KeySslPassPhrase,
                                               'password');
        CertEdit.Text :=  IniFile.ReadString(SectionData, KeySslCert,
                                               '01cert.pem');
        CAFileEdit.Text :=  IniFile.ReadString(SectionData, KeySslCaFile,
                                               'TrustedCABundle.pem');
        CAPathEdit.Text :=  IniFile.ReadString(SectionData, KeySslCaPath,
                                               'TrustedCaStore');
        PriorityComboBox.ItemIndex := IniFile.ReadInteger(SectionData, KeyPriority, 2);

        if not LoadStringsFromIniFile(FIniFileName, SectionFileAttach,
                                      KeyFileAttach, FileAttachMemo.Lines) then
        FileAttachMemo.Text := 'ics_logo.gif' + #13#10 + 'fp_small.gif';
        if not LoadStringsFromIniFile(FIniFileName, SectionMsgMemo,
                                      KeyMsgMemo, MsgMemo.Lines) then
            MsgMemo.Text :=
            'This is the first line' + #13#10 +
            'Then the second one' + #13#10 +
            'The next one is empty' + #13#10 +
            '' + #13#10 +
            'The next one has only a single dot' + #13#10 +
            '.' + #13#10 +
            'Finally the last one' + #13#10;
        Top    := IniFile.ReadInteger(SectionWindow, KeyTop,    (Screen.Height - Height) div 2);
        Left   := IniFile.ReadInteger(SectionWindow, KeyLeft,   (Screen.Width - Width) div 2);
        Width  := IniFile.ReadInteger(SectionWindow, KeyWidth,  Width);
        Height := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);

        IniFile.Free;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
    IniFile : TIniFile;
begin
    IniFile := TIniFile.Create(FIniFileName);
    IniFile.WriteString(SectionData, KeyHost,             HostEdit.Text);
    IniFile.WriteString(SectionData, KeyPort,             PortEdit.Text);
    IniFile.WriteString(SectionData, KeyFrom,             FromEdit.Text);
    IniFile.WriteString(SectionData, KeyTo,               ToEdit.Text);
    IniFile.WriteString(SectionData, KeyCc,               CcEdit.Text);
    IniFile.WriteString(SectionData, KeyBcc,              BccEdit.Text);
    IniFile.WriteString(SectionData, KeySubject,          SubjectEdit.Text);
    IniFile.WriteString(SectionData, KeySignOn,           SignOnEdit.Text);
    IniFile.WriteString(SectionData, KeyUser,             UsernameEdit.Text);
    IniFile.WriteString(SectionData, KeyPass,             PasswordEdit.Text);
    IniFile.WriteInteger(SectionData, KeyAuth,            AuthComboBox.ItemIndex);
    IniFile.WriteInteger(SectionData, KeySmtpSslMode,     SmtpSslModeCombobox.ItemIndex);
    IniFile.WriteBool(SectionData, KeySslVerifyPeer,      VerifyPeerCheckBox.Checked);
    IniFile.WriteString(SectionData, KeySslKey,           KeyEdit.Text);
    IniFile.WriteString(SectionData, KeySslPassPhrase,    PassPhraseEdit.Text);
    IniFile.WriteString(SectionData, KeySslCert,          CertEdit.Text);
    IniFile.WriteString(SectionData, KeySslCaFile,        CAFileEdit.Text);
    IniFile.WriteString(SectionData, KeySslCaPath,        CAPathEdit.Text);
    IniFile.WriteInteger(SectionData, KeyPriority,        PriorityComboBox.ItemIndex);
    SaveStringsToIniFile(FIniFileName, SectionFileAttach,
                         KeyFileAttach, FileAttachMemo.Lines);
    SaveStringsToIniFile(FIniFileName, SectionMsgMemo,
                         KeyMsgMemo, MsgMemo.Lines);
    IniFile.WriteInteger(SectionWindow, KeyTop,    Top);
    IniFile.WriteInteger(SectionWindow, KeyLeft,   Left);
    IniFile.WriteInteger(SectionWindow, KeyWidth,  Width);
    IniFile.WriteInteger(SectionWindow, KeyHeight, Height);
    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
function TrimRight(Str : String) : String;
var
    i : Integer;
begin
    i := Length(Str);
    while (i > 0) and (Str[i] = ' ') do
        i := i - 1;
    Result := Copy(Str, 1, i);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TrimLeft(Str : String) : String;
var
    i : Integer;
begin
    if Str[1] <> ' ' then
        Result := Str
    else begin
        i := 1;
        while (i <= Length(Str)) and (Str[i] = ' ') do
            i := i + 1;
        Result := Copy(Str, i, Length(Str) - i + 1);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
    Result := TrimLeft(TrimRight(Str));
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SmtpClientDisplay(Sender: TObject; Msg: String);
begin
    Display(Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientResponse(Sender: TObject; Msg: String);
begin
    Display('<' + Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientCommand(Sender: TObject; Msg: String);
begin
    Display('>' + Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientGetData(
    Sender  : TObject;
    LineNum : Integer;
    MsgLine : Pointer;
    MaxLen  : Integer;
    var More: Boolean);
var
    Len : Integer;
begin
    if LineNum > MsgMemo.Lines.count then
        More := FALSE
    else begin
        Len := Length(MsgMemo.Lines[LineNum - 1]);
        { Truncate the line if too long (should wrap to next line) }
        if Len >= MaxLen then
            StrPCopy(MsgLine, Copy(MsgMemo.Lines[LineNum - 1], 1, MaxLen - 1))
        else
            StrPCopy(MsgLine, MsgMemo.Lines[LineNum - 1]);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientHeaderLine(
    Sender : TObject;
    Msg    : Pointer;
    Size   : Integer);
begin
    { This demonstrate how to add a line to the message header              }
    { Just detect one of the header lines and add text at the end of this   }
    { line. Use #13#10 to form a new line                                   }
    { Here we check for the From: header line and add a Comments: line      }
    if StrLIComp(Msg, 'From:', 5) = 0 then
        StrCat(Msg, #13#10 + 'Comments: This is a test');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.ClearDisplayButtonClick(Sender: TObject);
begin
    DisplayMemo.Clear;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.ExceptionHandler(Sender: TObject; E: Exception);
begin
    Application.ShowException(E);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Connect to the mail server }
procedure TSslSmtpTestForm.ConnectButtonClick(Sender: TObject);
begin
    FAllInOneFlag              := False;
    SslSmtpClient.Host         := HostEdit.Text;
    SslSmtpClient.Port         := PortEdit.Text;
    SslSmtpClient.HdrPriority  := TSmtpPriority(PriorityComboBox.ItemIndex);
    SslSmtpClient.SslType      := TSmtpSslType(SmtpSslModeComboBox.ItemIndex);
    if SslSmtpClient.SslType <> smtpTlsNone then begin
        SslContext1.SslPrivKeyFile := KeyEdit.Text;
        SslContext1.SslPassPhrase  := PassPhraseEdit.Text;
        SslContext1.SslCertFile    := CertEdit.Text;
        SslContext1.SslCAFile      := CAFileEdit.Text;
        SslContext1.SslCAPath      := CAPathEdit.Text;
        SslContext1.SslVerifyPeer  := VerifyPeerCheckBox.Checked;
        if SslContext1.SslVerifyPeer then begin
            SslSmtpClient.OnSslVerifyPeer := SslSmtpClientSslVerifyPeer;
            SslSmtpClient.OnSslHandshakeDone := SslSmtpClientSslHandshakeDone;
        end
        else begin
            SslSmtpClient.OnSslVerifyPeer := nil;
            SslSmtpClient.OnSslHandshakeDone := nil;
        end;
    end;
    SslSmtpClient.Connect;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send HELO command with our local identification }
procedure TSslSmtpTestForm.HeloButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.SignOn          := SignOnEdit.Text;
    SslSmtpClient.Helo;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.EhloButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.SignOn          := SignOnEdit.Text;
    SslSmtpClient.Ehlo;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.AuthButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.Username        := UsernameEdit.Text;
    SslSmtpClient.Password        := PasswordEdit.Text;
    SslSmtpClient.AuthType        := TSmtpAuthType(AuthComboBox.ItemIndex);
    SslSmtpClient.Auth;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ If smtpAuthNone is seleted then Open combines methods Connect and Helo.   }
{  If any other authentication type is selected then Open combines methods  }
{  Connect, Ehlo and Auth.                                                  }
procedure TSslSmtpTestForm.OpenButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    //SslSmtpClient.MailMessage     := MsgMemo.Lines;
    SslSmtpClient.Host            := HostEdit.Text;
    SslSmtpClient.Port            := PortEdit.Text;
    SslSmtpClient.SignOn          := SignOnEdit.Text;
    SslSmtpClient.Username        := UsernameEdit.Text;
    SslSmtpClient.Password        := PasswordEdit.Text;
    SslSmtpClient.AuthType        := TSmtpAuthType(AuthComboBox.ItemIndex);
    SslSmtpClient.HdrPriority     := TSmtpPriority(PriorityComboBox.ItemIndex);
    SslSmtpClient.SslType         := TSmtpSslType(SmtpSslModeComboBox.ItemIndex);
    if SslSmtpClient.SslType <> smtpTlsNone then begin
        SslContext1.SslPrivKeyFile := KeyEdit.Text;
        SslContext1.SslPassPhrase  := PassPhraseEdit.Text;
        SslContext1.SslCertFile    := CertEdit.Text;
        SslContext1.SslCAFile      := CAFileEdit.Text;
        SslContext1.SslCAPath      := CAPathEdit.Text;
        SslContext1.SslVerifyPeer  := VerifyPeerCheckBox.Checked;
        if SslContext1.SslVerifyPeer then begin
            SslSmtpClient.OnSslVerifyPeer := SslSmtpClientSslVerifyPeer;
            SslSmtpClient.OnSslHandshakeDone := SslSmtpClientSslHandshakeDone;
        end
        else begin
            SslSmtpClient.OnSslVerifyPeer := nil;
            SslSmtpClient.OnSslHandshakeDone := nil;
        end;
    end;
    SslSmtpClient.Open;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send originator }
procedure TSslSmtpTestForm.MailFromButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.FromName        := FromEdit.Text;
    SslSmtpClient.MailFrom;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send recipients }
procedure TSslSmtpTestForm.RcptToButtonClick(Sender: TObject);
begin
    FAllInOneFlag := FALSE;
    SslSmtpClient.RcptName.Clear;
    SslSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
    SslSmtpClient.RcptTo;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Send text and attached files to mail server }
procedure TSslSmtpTestForm.DataButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.RcptName.Clear;
    SslSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
    SslSmtpClient.HdrFrom         := FromEdit.Text;
    SslSmtpClient.HdrTo           := ToEdit.Text;
    SslSmtpClient.HdrCc           := CcEdit.Text;
    SslSmtpClient.HdrSubject      := SubjectEdit.Text;
    SslSmtpClient.EmailFiles      := FileAttachMemo.Lines;
    SslSmtpClient.SendMode        := smtpCopyToStream;
    SslSmtpClient.Data;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ MailFrom, RcptTo and Data methods combined }
procedure TSslSmtpTestForm.MailButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.RcptName.Clear;
    SslSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
    SslSmtpClient.HdrFrom         := FromEdit.Text;
    SslSmtpClient.HdrTo           := ToEdit.Text;
    SslSmtpClient.HdrCc           := CcEdit.Text;
    SslSmtpClient.HdrSubject      := SubjectEdit.Text;
    SslSmtpClient.SignOn          := SignOnEdit.Text;
    SslSmtpClient.FromName        := FromEdit.Text;
    SslSmtpClient.EmailFiles      := FileAttachMemo.Lines;
    SslSmtpClient.Host            := HostEdit.Text;
    SslSmtpClient.Port            := PortEdit.Text;
    //SslSmtpClient.SendMode        := smtpCopyToStream;
    SslSmtpClient.Mail;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.QuitButtonClick(Sender: TObject);
begin
    FAllInOneFlag                 := FALSE;
    SslSmtpClient.Quit;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.AbortButtonClick(Sender: TObject);
begin
    FAllInOneFlag := FALSE;
    SslSmtpClient.Abort;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientRequestDone(
    Sender : TObject;
    RqType : TSmtpRequest;
    Error  : Word);
begin
    { For every operation, we display the status }
    if (Error > 0) and  (Error < 10000) then
        Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
                    ' Error='+ SslSmtpClient.ErrorMessage)
    else
        Display('RequestDone Rq=' + IntToStr(Ord(RqType)) +
                            ' Error='+ IntToStr(Error));
    { Check if the user has asked for "All-In-One" demo }
    if not FAllInOneFlag then
        Exit;             { No, nothing more to do here }
    { We are in "All-In-One" demo, start next operation }
    { But first check if previous one was OK            }
    if Error <> 0 then begin
        FAllInOneFlag := FALSE;   { Terminate All-In-One demo }
        Display('Error, stoped All-In-One demo');
        Exit;
    end;
    case RqType of
    smtpConnect:  begin
                      if SslSmtpClient.AuthType = smtpAuthNone then
                          SslSmtpClient.Helo
                      else
                          SslSmtpClient.Ehlo;
                  end;
    smtpHelo:     SslSmtpClient.MailFrom;
    smtpEhlo: if SslSmtpClient.SslType = smtpTlsExplicit then begin
                  Inc(FEhloCount);
                  if FEhloCount = 1 then
                      SslSmtpClient.StartTls
                  else if FEhloCount > 1 then
                      SslSmtpClient.Auth;
              end
              else
                  SslSmtpClient.Auth;
    smtpStartTls: SslSmtpClient.Ehlo; // We need to re-issue the Ehlo command
    smtpAuth:     SslSmtpClient.MailFrom;
    smtpMailFrom: SslSmtpClient.RcptTo;
    smtpRcptTo:   SslSmtpClient.Data;
    smtpData:     SslSmtpClient.Quit;
    smtpQuit:     Display('All-In-One done !');
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.AllInOneButtonClick(Sender: TObject);
begin
    if SslSmtpClient.Connected then begin
        MessageBeep(MB_OK);
        Display('All-In-One demo start in connected state.');
        Display('Please quit or abort the connection first.');
        Exit;
    end;

    FAllInOneFlag               := TRUE;
    FEhloCount                  := 0;
    { Initialize all SMTP component properties from our GUI }
    SslSmtpClient.Host          := HostEdit.Text;
    SslSmtpClient.Port          := PortEdit.Text;
    SslSmtpClient.SignOn        := SignOnEdit.Text;
    SslSmtpClient.FromName      := FromEdit.Text;
    SslSmtpClient.HdrFrom       := FromEdit.Text;
    SslSmtpClient.HdrTo         := ToEdit.Text;
    SslSmtpClient.HdrCc         := CcEdit.Text;
    SslSmtpClient.HdrSubject    := SubjectEdit.Text; { + #13#10#9 + ' Testing continuation line !'};
    SslSmtpClient.EmailFiles    := FileAttachMemo.Lines;
    SslSmtpClient.AuthType      := TSmtpAuthType(AuthComboBox.ItemIndex);

    SslSmtpClient.SslType       := TSmtpSslType(SmtpSslModeComboBox.ItemIndex);
    if SslSmtpClient.SslType <> smtpTlsNone then begin
        SslContext1.SslPrivKeyFile := KeyEdit.Text;
        SslContext1.SslPassPhrase  := PassPhraseEdit.Text;
        SslContext1.SslCertFile    := CertEdit.Text;
        SslContext1.SslCAFile      := CAFileEdit.Text;
        SslContext1.SslCAPath      := CAPathEdit.Text;
        SslContext1.SslVerifyPeer  := VerifyPeerCheckBox.Checked;
        if SslContext1.SslVerifyPeer then begin
            SslSmtpClient.OnSslVerifyPeer := SslSmtpClientSslVerifyPeer;
            SslSmtpClient.OnSslHandshakeDone := SslSmtpClientSslHandshakeDone;
        end
        else begin
            SslSmtpClient.OnSslVerifyPeer := nil;
            SslSmtpClient.OnSslHandshakeDone := nil;
        end;
    end;

    SslSmtpClient.Username       := UsernameEdit.Text;
    SslSmtpClient.Password       := PasswordEdit.Text;
    SslSmtpClient.HdrPriority    := TSmtpPriority(PriorityComboBox.ItemIndex);
    { Recipient list is computed from To, Cc and Bcc fields }
    SslSmtpClient.RcptName.Clear;
    SslSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text);
    Display('Connecting to SMTP server...');
    { Start first operation to do to send an email          }
    { Next operations are started from OnRequestDone event  }
    SslSmtpClient.Connect;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientBeforeFileOpen(Sender: TObject;
  Idx: Integer; FileName: String; var Action: TSmtpBeforeOpenFileAction);
begin
    Action := smtpBeforeOpenFileNone;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.TlsButtonClick(Sender: TObject);
begin
    FAllInOneFlag := FALSE;
    SslSmtpClient.StartTls;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.WMSslReconnect(var Msg: TMessage);
begin
    OpenButtonClick(Self);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientSslVerifyPeer(Sender: TObject;
    var Ok  : Integer;
    Cert    : TX509Base);
begin
    DisplayMemo.Lines.Add(
            'Received certificate - Depth: ' +
            IntToStr(Cert.VerifyDepth)+ #13#10 +
            'Subject: "' + Cert.SubjectOneLine + '"'#13#10 +
            'Issuer:  "' + Cert.IssuerOneLine + '"'#13#10  +
            'Verify result: ' + Cert.VerifyErrMsg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSslSmtpTestForm.SslSmtpClientSslHandshakeDone(Sender: TObject;
  ErrCode: Word; PeerCert: TX509Base; var Disconnect: Boolean);
begin
    if (ErrCode = 0) then
        if PeerCert.PostConnectionCheck(SslSmtpClient.Host) then
            DisplayMemo.Lines.Add('! Post connection check ok')
        else begin
            DisplayMemo.Lines.Add('! Post connection check **failed** - ' +
                                  'Hostname "' + SslSmtpClient.Host +
                                  '" not found in peer certificate');
            Disconnect := TRUE;
        end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.

