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!