Delphi - Encrypt email - S/MIME¶

unit Unit1;

interface
// include EASendMailObjLib_TLB unit to your Delphi Project
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, EASendMailObjLib_TLB, StdCtrls;

Unit Unit1;

Interface

Uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, EASendMailObjLib_TLB; // add EASendMail Unit

Type
    TForm1 = Class(TForm)
        Button1: TButton;
        Procedure Button1Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    End;

Const
    CRYPT_MACHINE_KEYSET = 32;
    CRYPT_USER_KEYSET = 4096;
    CERT_SYSTEM_STORE_CURRENT_USER = 65536;
    CERT_SYSTEM_STORE_LOCAL_MACHINE = 131072;

    ConnectNormal = 0;
    ConnectSSLAuto = 1;
    ConnectSTARTTLS = 2;
    ConnectDirectSSL = 3;
    ConnectTryTLS = 4;

Var
    Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.Button1Click(Sender: TObject);
Var
    oSmtp : TMail;
    oEncryptCert : TCertificate;
Begin
    oSmtp := TMail.Create(Application);
    oSmtp.LicenseCode := 'TryIt';

    // Set your sender email address
    oSmtp.FromAddr := 'test@emailarchitect.net';

    // Add recipient email address
    oSmtp.AddRecipientEx('support@emailarchitect.net', 0);

    // Set email subject
    oSmtp.Subject := 'test encrypted email from Delphi with digital signature';

    // Set body text
    oSmtp.BodyText := 'this is a test encrypted email sent from Delphi with digital signature';

    // Add digital signature
    If Not oSmtp.SignerCert.FindSubject('test@emailarchitect.net',
        CERT_SYSTEM_STORE_CURRENT_USER, 'my') Then
        Begin
        ShowMessage(oSmtp.SignerCert.GetLastError());
        exit;
        End;

    If Not oSmtp.SignerCert.HasCertificate Then
        Begin
        ShowMessage('Signer certificate has no private key, ' +
        'this certificate can not be used to sign email');
        End;

    // Find the encrypting certificate for every recipients
    oEncryptCert := TCertificate.Create(Application);
    If Not oEncryptCert.FindSubject('support@emailarchitect.net',
        CERT_SYSTEM_STORE_CURRENT_USER, 'AddressBook') Then
        If Not oEncryptCert.FindSubject('support@emailarchitect.net',
        CERT_SYSTEM_STORE_CURRENT_USER, 'my') Then
        Begin
        ShowMessage(oEncryptCert.GetLastError());
        exit;
        End;

    // Add encrypting certificate
    oSmtp.RecipientsCerts.Add(oEncryptCert.DefaultInterface);

    // Your SMTP server address
    oSmtp.ServerAddr := 'smtp.emailarchitect.net';

    // User and password for ESMTP authentication, if your server doesn't require
    // user authentication, please remove the following codes
    oSmtp.UserName := 'test@emailarchitect.net';
    oSmtp.Password := 'testpassword';

    // ConnectTryTLS means if server supports SSL/TLS connection, SSL/TLS is used automatically
    oSmtp.ConnectType := ConnectTryTLS;

    // If your server uses 587 port
    // oSmtp.ServerPort := 587;

    // If your server uses 25/587/465 port with SSL/TLS
    // oSmtp.ConnectType := ConnectSSLAuto;
    // oSmtp.ServerPort := 587; // 25 or 587 or 465

    ShowMessage('start to send email ...');

    If oSmtp.SendMail() = 0 Then
        ShowMessage('email was sent successfully!')
    Else
        ShowMessage('failed to send email with the following error: '
        + oSmtp.GetLastErrDescription());

End;

End.