CryptoAPI vs CAPICOM

From: Kim Madsen (kh_at_microsoft.com)
Date: 08/30/04 

Date: Mon, 30 Aug 2004 12:30:34 +0200

Hi,

Im signing a mail with a digital signature, using CAPICOM to get my
certificate and sign my data, that works fine.

My problem is that when I sign my data for the mail:

szSignature = oSignedData.Sign(oSigner, True, CAPICOM_ENCODE_BINARY)

the thirt party (TDC, CA in denmark) comes up with a prompt box to type in
password for the certificate. That is a problem because my code has to be
running on a server.

TDC says that I have to use: CryptSetKeyParam(hash,Password,)

Then I can sign my data without it prompt me for a password.

So my question is:

How do I sign my mail using CryptoAPI when I can not use CAPICOM ?

Best Regards

Kim

Private Function SignMessage(ByRef oMsg As CDO.Message, bClear As Boolean)
As Boolean
    Dim oSignedMsg As New CDO.Message
    Dim oBodyPart As CDO.IBodyPart
    Dim cFields As ADODB.Fields
    Dim oStream As ADODB.Stream
    Dim oSignedData As New CAPICOM.SignedData
    Dim oUtilities As New CAPICOM.Utilities
    Dim oAttribute As New CAPICOM.Attribute
    Dim oSignerCertificate As CAPICOM.Certificate
    Dim cSignerCertificates As CAPICOM.Certificates
    Dim oStore As New CAPICOM.Store
    'Dim szSignature, byteSignature() As Byte

    On Error GoTo ErrorHandler

    ' create the SignedData object we will use to create the PKCS7
    Set oSignedData = New CAPICOM.SignedData

    ' create the new message
    Set oSignedMsg = New CDO.Message

    ' select the signer certificate
    oStore.Open CAPICOM_CURRENT_USER_STORE, "My",
CAPICOM_STORE_OPEN_READ_ONLY
    Set cSignerCertificates =
oStore.Certificates.Find(CAPICOM_CERTIFICATE_FIND_EXTENDED_PROPERTY,
CERT_KEY_SPEC_PROP_ID).Find(CAPICOM_CERTIFICATE_FIND_APPLICATION_POLICY,
"Secure Email")

    Select Case cSignerCertificates.Count
        Case 0
            MsgBox ("Error: No signing certificate can be found.")
        Case 1
            oSigner.Certificate = cSignerCertificates(1)
        Case Else
            Set cSignerCertificates = cSignerCertificates.Select("S/MIME
Certificates", "Please select a certificate to sign with.")
            If (cSignerCertificates.Count = 0) Then
                MsgBox ("Error: Certificate selection dialog was
cancelled.")
                Exit Function
            End If
            oSigner.Certificate = cSignerCertificates(1)
    End Select

    ' set the from field based off of the selected certificate
    oSignedMsg.From =
oSigner.Certificate.GetInfo(CAPICOM_CERT_INFO_SUBJECT_EMAIL_NAME)

    ' set the signing time in UTC time
    Set oAttribute = New CAPICOM.Attribute
    oAttribute.Name = CAPICOM_AUTHENTICATED_ATTRIBUTE_SIGNING_TIME
    oAttribute.Value = oUtilities.LocalTimeToUTCTime(Now)
    oSigner.AuthenticatedAttributes.Add oAttribute

    Select Case bClear
    Case True
        ' this is to be a clear text signed message so we need to copy the
interesting
        ' parts (sender, recipient, and subject) into the new header
        oSignedMsg.To = oMsg.To
        oSignedMsg.CC = oMsg.CC
        oSignedMsg.Subject = oMsg.Subject

        Set oBodyPart = oSignedMsg.BodyPart.AddBodyPart
        Set cFields = oBodyPart.Fields
        cFields.Item(cdoContentType).Value =
oMsg.BodyPart.BodyParts(1).Fields.Item(cdoContentType).Value
        cFields.Update

        Set oStream = oBodyPart.GetDecodedContentStream
        oStream.WriteText
oMsg.BodyPart.BodyParts(1).GetDecodedContentStream.ReadText
        oStream.Flush

        ' set the content to be signed
        oSignedData.Content =
StrConv(oSignedMsg.BodyPart.BodyParts(1).GetStream.ReadText, vbFromUnicode)

        ' sign the content
        szSignature = oSignedData.Sign(oSigner, True, CAPICOM_ENCODE_BINARY)

        ' Get the string data as a byte array
        byteSignature = szSignature

        ' Attach the signature and let CDO base64 encode it
        Set oBodyPart = oSignedMsg.BodyPart.AddBodyPart
        Set cFields = oBodyPart.Fields
        oBodyPart.Fields.Item("urn:schemas:mailheader:content-type").Value =
"application/x-pkcs7-signature" & vbCrLf & "Name = ""smime.p7s"""

oBodyPart.Fields.Item("urn:schemas:mailheader:content-transfer-encoding").Va
lue = "base64"

oBodyPart.Fields.Item("urn:schemas:mailheader:content-disposition").Value =
"attachment;" & vbCrLf & "FileName=""smime.p7s"""
        cFields.Update

        Set oStream = oBodyPart.GetDecodedContentStream
        oStream.Type = ADODB.StreamTypeEnum.adTypeBinary
        oStream.Write (byteSignature)
        oStream.Flush

        ' Set the messages content type, this needs to be done last to
ensure it is not changed when we add the BodyParts
        oSignedMsg.Fields.Item("urn:schemas:mailheader:content-type").Value
= "multipart/signed;" & vbCrLf &
"protocol=""application/x-pkcs7-signature"";" & vbCrLf & "micalg=SHA1;"
        oSignedMsg.Fields.Update

    Case False
        ' this is to be a opaquely signed message so we need to copy the
entire message into our
        ' new encrypted message
        oSignedMsg.DataSource.OpenObject oMsg, cdoIMessage

        ' Set up main bodypart
        Set oBodyPart = oSignedMsg.BodyPart
        oBodyPart.ContentMediaType = "application/pkcs7-mime;" & vbCrLf &
"smime-type=signed-data;" & vbCrLf & "name=""smime.p7m"""
        oBodyPart.ContentTransferEncoding = "base64"
        oBodyPart.Fields("urn:schemas:mailheader:content-disposition") =
"attachment;" & vbCrLf & "FileName=""smime.p7m"""
        oBodyPart.Fields.Update

        ' set the from field based off of the selected certificate
        oMsg.From =
oSigner.Certificate.GetInfo(CAPICOM_CERT_INFO_SUBJECT_EMAIL_NAME)

        ' set the content to be signed
        oSignedData.Content = StrConv(oMsg.BodyPart.GetStream.ReadText,
vbFromUnicode)

        ' Sign the content
        szSignature = oSignedData.Sign(oSigner, False,
CAPICOM_ENCODE_BINARY)

        ' Get the string data as a byte array
        byteSignature = szSignature

        ' Attach the signature and let CDO base64 encode it
        Set oStream = oBodyPart.GetDecodedContentStream
        oStream.Type = ADODB.StreamTypeEnum.adTypeBinary
        oStream.Write (byteSignature)
        oStream.Flush
    End Select

    ' Signing Was sucessfull
    SignMessage = True
    Set oMsg = oSignedMsg

GoTo CleanUp

ErrorHandler:
    'If the user cancels, don't display error message
    If Err.Number <> CAPICOM_E_CANCELLED Then
        MsgBox "Error: " & Hex(Err.Number) & ": " & Err.Description
    End If
    Err.Clear

    ' An error occurred
    SignMessage = False
    Set oMsg = Nothing

CleanUp:
    Set oSignedMsg = Nothing
    Set oBodyPart = Nothing
    Set cFields = Nothing
    Set oStream = Nothing
    Set oSignedData = Nothing
    Set oUtilities = Nothing
    Set oAttribute = Nothing
    Set oSignerCertificate = Nothing
    Set cSignerCertificates = Nothing
    Set oStore = Nothing
End Function

Relevant Pages

  • RE: CryptoAPI vs CAPICOM
    ... >certificate and sign my data, ... > Dim oSignedMsg As New CDO.Message ... > Set oSignedData = New CAPICOM.SignedData ... > Set oAttribute = New CAPICOM.Attribute ...
    (microsoft.public.dotnet.security)
  • Re: Getting 403 Forbidden error. Client Cert didnt sent
    ... What I tried to do is to attach a client certificate and post an XML ... Dim oWebRequest As Net.HttpWebRequest ... Dim oWebResponse As Net.HttpWebResponse ... Dim txtResponse As String ...
    (microsoft.public.dotnet.framework.aspnet.security)
  • Re: Getting 403 Forbidden error. Client Cert didnt sent
    ... and enabled the Client Authentication under Thawte Premium Server CA. ... What I tried to do is to attach a client certificate and post an XML ... Dim oWebRequest As Net.HttpWebRequest ...
    (microsoft.public.dotnet.framework.aspnet.security)
  • Re: regarding retrival of server certificate
    ... Imports System.Collections ... Dim sslstream As SslStream ... Dim certificate, servercertificate As New X509Certificate ... get a server certificate for validation and authentication. ...
    (microsoft.public.dotnet.security)
  • Using X509 certificates with a password
    ... provided the certificate isn't protected ... Dim storeMy As New X509Store(StoreName.My, ... ' Create a collection of available certs that have the digital ... ' Sign the message with the private key of the signer. ...
    (microsoft.public.dotnet.languages.vb)