VB6 - Verify digital signature and decrypt email - S/MIME¶

Option Explicit

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

Private Sub ParseEmail(ByVal emlFile As String)
    Dim oMail As New EAGetMailObjLib.Mail
    oMail.LicenseCode = "TryIt"

On Error GoTo ErrorHandle
    oMail.LoadFile emlFile, False

    If oMail.IsEncrypted Then
        ' This email is encrypted, we decrypt it by user default certificate.
        ' You can also use specified certificate like this
        ' Dim oCert As New EAGetMailObjLib.Certificate
        ' oCert.LoadFromFile "c:\test.pfx", "pfxpassword", CRYPT_USER_KEYSET
        ' Set oMail = oMail.Decrypt(oCert)
        Set oMail = oMail.Decrypt(Nothing)
    End If

    If oMail.IsSigned Then
        ' This email is digital signed.
        Dim oCert As EAGetMailObjLib.Certificate
        Set oCert = oMail.VerifySignature
        MsgBox "This email contains a valid digital signature."
        ' You can add the certificate to your certificate storage like this
        ' oCert.AddToStore CERT_SYSTEM_STORE_CURRENT_USER, "addressbook"
        ' Then you can use send the encrypted email back to this sender.
    End If

    ' Parse email sender
    MsgBox "From: " & oMail.From.Address

    Dim addressList As EAGetMailObjLib.AddressCollection
    Dim i As Long
    Dim addr As EAGetMailObjLib.MailAddress

    ' Parse email to recipients
    Set addressList = oMail.ToList
    For i = 0 To addressList.Count - 1
        Set addr = addressList.Item(i)
        MsgBox "To: " & addr.Address
    Next

    ' Parse email cc
    Set addressList = oMail.CcList
    For i = 0 To addressList.Count - 1
        Set addr = addressList.Item(i)
        MsgBox "Cc: " & addr.Address
    Next

    ' Parse email subject
    MsgBox "Subject: " & oMail.Subject

    ' Parse email text body
    MsgBox "Text body: " & oMail.TextBody

    ' Parse email HTML body
    MsgBox "Html body: " & oMail.HtmlBody

    ' Parse attachments
    Dim atts As EAGetMailObjLib.AttachmentCollection
    Dim att As EAGetMailObjLib.Attachment

    Set atts = oMail.AttachmentList
    For i = 0 To atts.Count - 1
        Set att = atts.Item(i)
        MsgBox "Attachment: " & att.name
    Next

    Exit Sub
ErrorHandle:
    MsgBox Err.Description
End Sub

Private Sub Command1_Click()

    ParseEmail "c:\my folder\test.eml"

End Sub