Microsoft KB Archive/318215

= How To Create a Multipart SMIME Signature by Using CAPICOM and CDO =

Article ID: 318215

Article Last Modified on 11/21/2006

-

APPLIES TO

 Microsoft Win32 Application Programming Interface, when used with:  Microsoft Windows 2000 Standard Edition

 Microsoft Windows XP Professional 

-



This article was previously published under Q318215



SUMMARY
A multipart signed message is a message that contains original content and a signature of that content. The original content is used to verify the signature. Programs such as e-mail clients Microsoft Outlook and Microsoft Outlook Express can verify the signature and identify whether the original content has been changed.

This article explains how to programmatically generate a multipart signed message that other programs can verify. Programs that can verify multipart signatures include Outlook, Outlook Express, and Microsoft BizTalk Server.



Create a Multipart Signed Message

 * 1) Start with a CDOSYS or CDOEx IMessage object. Configure this message with sender, recipient, subject, attachments, and other elements of the message. (With some programs, such as BizTalk Server, you do not need to do this.)
 * 2) Make the content type multipart/signed.
 * 3) Add the first BodyPart object to the message.
 * 4) Set content type to text/plain, and then add the file contents to the first decoded stream of the BodyPart object.
 * 5) Sign the first BodyPart stream using CAPICOM.
 * 6) Add a second BodyPart to the message object.
 * 7) Set content type to application/pkcs7-signature, and then set the Content-Transfer-Encoding to base64.
 * 8) Get the encoded stream of the second BodyPart, and then add the signed message from step 5.
 * 9) Get all of the message object's stream.

Sample Code
The following sample code requires references to the CAPICOM Type Library, the Microsoft ActiveX Data Objects Library, and the Microsoft CDO for Exchange 2000 Library. Public Function CreateSignature(szFileToSign As String, szCertName As String) As String Dim iMsg As New CDO.Message Dim Flds As ADODB.Fields Dim MsgToSign As String

' You can add the following lines to create a ' multipart/signed e-mail that Outlook Express can ' verify. Just save as an .eml file. ' With iMsg '   .To = &quot;&quot;&quot;You&quot;&quot;&quot; '   .From = &quot;&quot;&quot;Me&quot;&quot; <Me@dot.com>&quot; '   .subject = &quot;Here is a signed message&quot; ' End With ' iMsg Dim iBp As CDO.IBodyPart Dim iBp2 As CDO.IBodyPart

Set iBp = iMsg  '  get IBodyPart on Message object

' Set up main header. ' This will be a multipart/signed signature. Set Flds = iBp.Fields iMsg.MimeFormatted = True Flds(&quot;urn:schemas:mailheader:content-type&quot;) = &quot;multipart/signed; protocol=application/pkcs7-signature; micalg=SHA1&quot; Flds(&quot;urn:schemas:mailheader:thread-index&quot;) = &quot;&quot; Flds(&quot;urn:schemas:mailheader:priority&quot;) = &quot;&quot; Flds(&quot;urn:schemas:mailheader:importance&quot;) = &quot;&quot; Flds(&quot;urn:schemas:mailheader:content-class&quot;) = &quot;&quot; Flds.Update

' Setup the first body part; this is the header ' plus the file contents. Set iBp2 = iBp.AddBodyPart Set Flds = iBp2.Fields Flds(&quot;urn:schemas:httpmail:content-media-type&quot;) = &quot;text/plain&quot; Flds(&quot;urn:schemas:mailheader:content-type&quot;) = &quot;text/plain; charset=UTF-8&quot; Flds(&quot;urn:schemas:mailheader:content-class&quot;) = &quot;urn:content-classes:message&quot; Flds(&quot;urn:schemas:mailheader:content-transfer-encoding&quot;) = &quot;7bit&quot; Flds.Update

Dim Stm As ADODB.Stream Dim StrBase64 As String ' Make sure you have the file name and the certificate name. If (szFileToSign = &quot;&quot;) Then MsgBox &quot;Please enter file name to sign.&quot;,, &quot;More Info Needed&quot; Exit Function End If  If (szCertName = &quot;&quot;) Then MsgBox &quot;Please Enter Certificate name.&quot;,, &quot;More Info Needed&quot; Exit Function End If  ' Load the contents of the file that is to be signed. MsgToSign = LoadFile(szFileToSign) ' Get the decoded stream and add the contents of the file to the stream. Set Stm = iBp2.GetDecodedContentStream Stm.WriteText MsgToSign Stm.Flush ' Pass in the full stream (header and content) and sign it. StrBase64 = SignMessage(szCertName, iBp2.GetStream.ReadText) If StrBase64 = &quot;&quot; Then Exit Function ' Set up the second body part; this is header plus signed content. Set iBp2 = iBp.AddBodyPart Set Flds = iBp2.Fields Flds(&quot;urn:schemas:mailheader:content-type&quot;) = &quot;application/pkcs7-signature; Name = smime.p7s&quot; Flds(&quot;urn:schemas:mailheader:content-transfer-encoding&quot;) = &quot;base64&quot; Flds(&quot;urn:schemas:mailheader:content-Disposition&quot;) = &quot;attachment; FileName = smime.p7s&quot; Flds.Update

' Get the encoded stream and add the signed message to the stream. Set Stm = iBp2.GetEncodedContentStream Stm.Type = adTypeBinary Dim a As Byte a = StrConv(StrBase64, vbFromUnicode) Stm.Write a  Stm.Flush

' Get the whole SMIME message. CreateSignature = iMsg.GetStream.ReadText End Function

Public Function SignMessage(szCertName As String, msg As String) As String Dim oSignedData As New CAPICOM.SignedData Dim strData As String Dim strContent As String Dim oSigner As New CAPICOM.Signer Dim oCert As CAPICOM.Certificate Dim oAttr As New CAPICOM.Attribute Dim byteData As Byte On Error GoTo handle_error ' Get certificate. Set oCert = GetCertForSignature(szCertName) ' If no certificate, throw an error and then exit. If oCert Is Nothing Then MsgBox &quot;No valid certificate found for sender.&quot;,, &quot;Error&quot; SignMessage = &quot;&quot; Exit Function End If      ' Add certificate to signer object. oSigner.Certificate = oCert ' Add signing time attribute to signer object. oAttr.Name = CAPICOM_AUTHENTICATED_ATTRIBUTE_SIGNING_TIME oAttr.Value = Now oSigner.AuthenticatedAttributes.Add oAttr

' Sign the content (root bodypart). strContent = msg oSignedData.Content = StrConv(strContent, vbFromUnicode)

' True implies detached signature. strData = oSignedData.Sign(oSigner, True, CAPICOM_ENCODE_BASE64) SignMessage = strData GoTo cleanup ' Report error. handle_error: MsgBox Err.Number & &quot;: &quot; & Err.Description,, &quot;Error:&quot; SignMessage = &quot;&quot; Exit Function ' Clean up memory. cleanup: Set oSignedData = Nothing Set oSigner = Nothing Set oCert = Nothing Set oAttr = Nothing End Function

Public Function GetCertForSignature(subject As String) As CAPICOM.Certificate Dim cert As CAPICOM.Certificate Dim st As New CAPICOM.Store st.Open CAPICOM_CURRENT_USER_STORE, &quot;My&quot;, CAPICOM_STORE_OPEN_READ_ONLY For Each cert In st.Certificates If (cert.IsValid) And _ (StrComp(cert.GetInfo(CAPICOM_CERT_INFO_SUBJECT_SIMPLE_NAME), subject, vbTextCompare) = 0) And _ (cert.KeyUsage.IsDigitalSignatureEnabled) Then Set GetCertForSignature = cert Exit Function End If   Next Set GetCertForSignature = Nothing End Function

Public Function LoadFile(ByVal filename As String) As String Dim s As String Dim buffer As String

Open filename For Binary As #1 buffer = String(LOF(1), &quot; &quot;) Get #1,, buffer LoadFile = buffer Close #1 End Function

Public Sub SaveFile(ByVal filename As String, strData As String) ReDim Data(Len(strData)) As Byte Data = StrConv(strData, vbFromUnicode) Open filename For Binary As #1 Put #1,, Data Close #1 End Sub

<div class="references_section">