Dim xmldoc As New DOMDocument50
Dim xmldsig As New MXDigitalSignature50
Dim dsigKey As IXMLDSigKey
Dim saxReader As New SAXXMLReader50
Dim saxProxy, outfile, provType, keyContainer
Const DSIGNS = "xmlns:ds='http://www.w3.org/2000/09/xmldsig#'"
Const PROV_RSA_FULL = 1
' Change this key container name to your own if necessary.
Const RSA_KEY = "MyRSAFullKeys"
Const INFILE = "signature_template.rsa.xml"
Const dataID = "#objData"
Private Function LoadXML(ByVal file As String)
' Read the input XML file.
Path = App.Path + "\" + file
xmldoc.async = False
xmldoc.preserveWhiteSpace = True
xmldoc.validateOnParse = False
xmldoc.resolveExternals = False
If xmldoc.Load(Path) = False Then
WriteLine "Can't load " + Path
WriteLine "Reason: " + xmldoc.parseError.reason
LoadXML = False
Exit Function
End If
' Set the signature property on xmldsig.
xmldoc.setProperty "SelectionNamespaces", DSIGNS
Dim sig
Set sig = xmldoc.selectSingleNode(".//ds:Signature")
If sig Is Nothing Then
WriteLine "failed select <Signature>"
LoadXML = False
Exit Function
End If
Set xmldsig.signature = sig
LoadXML = True
End Function
Private Function SignXML(ByVal dataID As String, ByVal srcUrl As String)
If xmldsig.signature Is Nothing Then
WriteLine "Invalid signature template."
SignXML = False
Exit Function
End If
If keyContainer = "" Then
WriteLine "Invalid key container."
SignXML = False
Exit Function
End If
' Get the Key from the default csp provder.
Set oKey = xmldsig.createKeyFromCSP(provType, "", keyContainer, 0)
If oKey Is Nothing Then
WriteLine "Invalid key"
SignXML = False
Exit Function
End If
If srcUrl <> "" Then
' Reassign the data source.
Set saxProxy = xmldsig.createSAXProxy
If saxProxy Is Nothing Then
SignXML = False
Exit Function
End If
Set saxReader.contentHandler = saxProxy
xmldsig.setReferenceData dataID, saxProxy
saxReader.parseURL srcUrl
End If
CONTINUE:
Set oSignedKey = xmldsig.Sign(oKey, PURGE)
If oSignedKey Is Nothing Then
WriteLine "sign failed."
SignXML = False
Exit Function
End If
WriteLine "Signing was succesfful."
WriteLine "Resultant signature: " + vbNewLine
WriteLine xmldoc.xml
SignXML = True
End Function
Private Sub Form_Load()
'Resize the text box control to the size of the form
Text1.Top = 100
Text1.Left = 100
Text1.Width = Form1.Width - 350
Text1.Height = Form1.Height - 750
Dim newSrc As String
provType = PROV_RSA_FULL
keyContainer = RSA_KEY
writeClear
refID = "#objData"
If LoadXML(INFILE) = True Then
WriteLine "Signing data referenced in the signature..."
SignXML refID, ""
newSrc = App.Path + "\test.xml"
WriteLine vbNewLine
WriteLine "Signing " + newSrc + " fed through SAX Proxy..."
LoadXML INFILE
SignXML refID, newSrc
End If
End Sub
Private Sub Form_Resize()
'Resize the text box control to the size of the form
Text1.Width = Form1.Width - 350
Text1.Height = Form1.Height - 750
End Sub
' Helper function. Make sure that a TextBox control named Text1
' is present in the project.
Private Function WriteLine(ByVal str As String)
Text1.Text = Text1.Text + str + vbNewLine
End Function
' Helper function:
Private Function writeClear()
Text1.Text = ""
End Function
Try It!