ivan
  • ivan
  • 100% (Exalted)
  • Administration Topic Starter
14 years ago
VB6, VBA Example

' The following example codes demonstrate encrypting email message with digital signature - S/MIME
' To get full sample projects, please download and install EASendMail on your machine.
' To run it correctly, please change SMTP server, user, password, sender, recipient value to yours


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 btnEncryptEmail_Click() 

    Dim oSmtp As New EASendMailObjLib.Mail 
    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 VB 6.0 project" 

    ' Set email body
    oSmtp.BodyText = "this is a test encrypted email sent from VB 6.0 project" 

    ' 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" 

    ' If your smtp server requires SSL connection, please add this line
    ' oSmtp.SSL_init

    ' Add digital signature
    If Not oSmtp.SignerCert.FindSubject("test@emailarchitect.net", _ 
        CERT_SYSTEM_STORE_CURRENT_USER, "my") Then 
        MsgBox oSmtp.SignerCert.GetLastError() 
        Exit Sub 
    End If 

    If Not oSmtp.SignerCert.HasPrivateKey Then 
        MsgBox "Signer certificate has not private key, " & _ 
             " this certificate can not be used to sign email!" 
        Exit Sub 
    End If 

    ' Find the encrypting certificate for every recipients
    Dim oEncryptCert As New EASendMailObjLib.Certificate 
    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 
            MsgBox oEncryptCert.GetLastError() 
            Exit Sub 
        End If 
    End If 

    ' Add encrypting certificate
    oSmtp.RecipientsCerts.Add oEncryptCert 

    MsgBox "start to send email ..." 

    If oSmtp.SendMail() = 0 Then 
        MsgBox "email was sent successfully!" 
    Else 
        MsgBox "failed to send email with the following error:" & oSmtp.GetLastErrDescription() 
    End If 

End Sub 

Click here to read original topic - full version ... 

If you have any comments or questions about above example codes, please add your comments here.

EXPLORE TUTORIALS

© All Rights Reserved, AIFEI Software Limited & AdminSystem Software Limited.