VB.NET - Encrypt email - S/MIME¶

Imports System.Security.Cryptography.X509Certificates
' Add EASendMail namespace
Imports EASendMail

Module Module1

    Private Function _findCertificate(storeName As String, emailAddress As String) As X509Certificate2

        Dim cert As X509Certificate2 = Nothing
        Dim store As New X509Store(storeName, StoreLocation.CurrentUser)

        store.Open(OpenFlags.ReadOnly)
        Dim certfiicates As X509Certificate2Collection = store.Certificates.Find(X509FindType.FindBySubjectName, emailAddress, True)
        If certfiicates.Count > 0 Then
            cert = certfiicates(0)
        End If

        store.Close()

        _findCertificate = cert
    End Function

    Sub Main()

        Try
            Dim oMail As New SmtpMail("TryIt")

            ' Set sender email address, please change it to yours
            oMail.From = "test@emailarchitect.net"

            ' Set recipient email address, please change it to yours
            oMail.To = "support@emailarchitect.net"

            ' Set email subject
            oMail.Subject = "test encrypted email from vb.net"

            ' Set email body
            oMail.TextBody = "this is a test email with email encryption (S/MIME)"

            ' Search certificate based on email address.
            Dim signerCertificate As X509Certificate2 = _findCertificate("My", oMail.From.Address)
            If signerCertificate Is Nothing Then
                Throw New Exception("No signer certificate found for " + oMail.From.Address + "!")
            End If

            oMail.From.Certificate2 = signerCertificate
            ' You can also load the signer certificate from a pfx file.
            '
            ' Dim pfxPath As String = "D:\TestCerts\signer.pfx"
            ' Dim signerCertFromPfx As X509Certificate2 = New X509Certificate2(pfxPath,
            '        "nosecret",
            ' X509KeyStorageFlags.Exportable Or X509KeyStorageFlags.UserKeySet)
            ' oMail.From.Certificate2 = signerCertFromPfx

            ' If you use it in web application,
            ' please use  X509KeyStorageFlags.Exportable Or X509KeyStorageFlags.MachineKeySet

            ' If you use it in .NET core application
            ' please use X509KeyStorageFlags.Exportable Or X509KeyStorageFlags.EphemeralKeySet

            Dim count As Integer = oMail.To.Count
            For i As Integer = 0 To count - 1
                Dim oAddress As MailAddress = oMail.To(i)

                Dim encryptCert As X509Certificate2 = _findCertificate("AddressBook", oAddress.Address)
                If encryptCert Is Nothing Then
                    encryptCert = _findCertificate("My", oAddress.Address)
                End If

                If encryptCert Is Nothing Then
                    Throw New Exception("No encryption certificate found for " + oAddress.Address + "!")
                End If

                oAddress.Certificate2 = encryptCert

                ' You can also load the encryptor certificate from a cer file Like this

                ' Dim cerPath As String = "D:\TestCerts\encryptor.cer"
                ' Dim encryptCertFromFile = New X509Certificate2(cerPath)
                ' oAddress.Certificate2 = encryptCertFromFile
            Next

            ' Your SMTP server address
            Dim oServer As New SmtpServer("smtp.emailarchitect.net")

            ' User and password for ESMTP authentication, if your server doesn't require
            ' User authentication, please remove the following codes.
            oServer.User = "test@emailarchitect.net"
            oServer.Password = "testpassword"

            ' Most mordern SMTP servers require SSL/TLS connection now.
            ' ConnectTryTLS means if server supports SSL/TLS, SSL/TLS will be used automatically.
            oServer.ConnectType = SmtpConnectType.ConnectTryTLS

            ' If your SMTP server uses 587 port
            ' oServer.Port = 587

            ' If your SMTP server requires SSL/TLS connection on 25/587/465 port
            ' oServer.Port = 25 ' 25 or 587 or 465
            ' oServer.ConnectType = SmtpConnectType.ConnectSSLAuto

            Console.WriteLine("start to send encrypted email ...")

            Dim oSmtp As New SmtpClient()
            oSmtp.SendMail(oServer, oMail)

            Console.WriteLine("email was sent successfully!")

        Catch ep As Exception

            Console.WriteLine("failed to send email with the following error:")
            Console.WriteLine(ep.Message)
        End Try

    End Sub

End Module