PKCS7 Encrypt using Multiple Certificates

Encrypts MIME using multiple digital certificates. Calls AddEncryptCert once per certificate, followed by a call to EncryptN. The MIME may be decrypted by any owner of one of the certificates + its associated private key.

Download Chilkat MIME ActiveX

Dim mime As New ChilkatMime

Dim success As Long
success = mime.UnlockComponent("Anything for 30-day trial.")
If (success = 0) Then
    Text1.Text = Text1.Text & mime.LastErrorText & vbCrLf
    Exit Sub
End If

'  Build a simple MIME message to be encrypted:
mime.AddHeaderField "Content-Type","text/plain"
mime.AddHeaderField "abc","123"
mime.SetBody "This is a test"

'  A digital certificate is required to create PKCS7 encrypted MIME.
'  It can come from a variety of sources: .cer file, .pfx file, PEM files,
'  an in-memory representation, or directly from a Windows
'  registry-based certificate store.

'  Load one cert from a .cer file:
Dim cert1 As New ChilkatCert
success = cert1.LoadFromFile("myCert.cer")
If (success = 0) Then
    Text1.Text = Text1.Text & cert1.LastErrorText & vbCrLf
    Exit Sub
End If

'  Load another cert from the Windows registry store:
Dim cert2 As New ChilkatCert
success = cert2.LoadByCommonName("Chilkat Sales")
If (success = 0) Then
    Text1.Text = Text1.Text & cert2.LastErrorText & vbCrLf
    Exit Sub
End If

'  Tell the MIME object to use these certs for encrypting:
'  (AddEncryptCert shouldn't fail if we already know it contains
'  a valid certificate..)
success = mime.AddEncryptCert(cert1)
success = mime.AddEncryptCert(cert2)

'  Encrypt the MIME:
success = mime.EncryptN()
If (success = 0) Then
    Text1.Text = Text1.Text & mime.LastErrorText & vbCrLf
    Exit Sub
End If

'  Display the MIME:
Text1.Text = Text1.Text & mime.GetMime() & vbCrLf

'  The resulting S/MIME looks something like this:
'  
abc: 123
Content-Disposition: attachment; filename="smime.p7m"
Content-Transfer-Encoding: base64
Content-Type: application/x-pkcs7-mime;
 name="smime.p7m"

MIID4QYJKoZIhvcNAQcDoIID0jCCA84CAQAxggNlMIIBgQIBADBpMFUxCzAJBgNVBAYTAlpBMSUw
IwYDVQQKExxUaGF3dGUgQ29uc3VsdGluZyAoUHR5KSBMdGQuMR8wHQYDVQQDExZUaGF3dGUgQ29k
ZSBTaWduaW5nIENBAhB4ouTcAmLszrGi170k1deSMA0GCSqGSIb3DQEBAQUABIIBAKnOPgmISrNH
Hd+zESvH5dl5TvBLCxLuIuH6cuZdowHzCqAUzaYFdn1rp88Vvu2x3s6WOvzje/+dE1x0YjEpeqxd
ufehlb6Jl9ucxSMWARWMxWGxu0eZGJVt+SBBrVddqdtrIU9lVt5rBxkU67P8PxgbwdNCX3qJENRO
P/rvp5ngoCkpIxeGqSkPvWv+CA3IXS8FPs8Sl4HNPiAj3e9RBm2MxI1u4cn1HvgGg8yHgHLMG5JF
LzGsmotSQaqEwq2JtOlkjfOwEI+ZhbWQupj6gen2aGc5sW3J26H1usxtV2TQ7WRRxqnZGmlh20dW
4lo3kITYI+iapGlJXmrlDYh2CjkwggHcAgEAMIHDMIGuMQswCQYDVQQGEwJVUzELMAkGA1UECBMC
VVQxFzAVBgNVBAcTDlNhbHQgTGFrZSBDaXR5MR4wHAYDVQQKExVUaGUgVVNFUlRSVVNUIE5ldHdv
cmsxITAfBgNVBAsTGGh0dHA6Ly93d3cudXNlcnRydXN0LmNvbTE2MDQGA1UEAxMtVVROLVVTRVJG
aXJzdC1DbGllbnQgQXV0aGVudGljYXRpb24gYW5kIEVtYWlsAhAj50QEWUPwA+jXOiL8sMwXMA0G
CSqGSIb3DQEBAQUABIIBAFQ1cydWC4M9tdgAlCN03kP8eyuXajwT+5ByhOcJhjuCABg7U8w4Rx28
braGqV+TCBxjyMsqD0KcW49VT6ZHMpQ1yN8R72qDsidmfm9w3u0jVgsaaBkTJXMy4COY/3cZWmYG
dL3Qty8uFeQYddytt6UPJpGJZYsrdFG2doe6qHiRtAxxPrd0GmQRcGvxyDdsojkoBlTMbfwaXOI3
xepR/oh60x/3npUCsl2VpNPfo6oZoej6YZGEuz2MvuWvXVhvuqoTqXGwGDgYMxwTbPwklqZiJtsK
r5Ep3NlWAQX8MGWL0H+NC22cqJuqUCL05yqyAv+JMCpZGAwOVb/wiVNjpAIwYAYJKoZIhvcNAQcB
MBkGCCqGSIb3DQMCMA0CAToECA5NAJY12cU+gDgZFUc+nsQUUbiR1GH8iBVLI+XWlja9TXEe1Hzt
NlsOylRVBDzjNxUtX/zC0YR7bs+2Cf4JbyuMOA==