Dim xmldoc As New DOMDocument50
Dim xmldsig As New MXDigitalSignature50
Dim dsigKey As IXMLDSigKey
Dim dataObj As IXMLDOMNode
Dim outfile
Dim 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.setRef.rsa.xml"
Const outfile2 = "signature.setRef.rsa.obj2.xml"
Const outfile1 = "signature.setRef.rsa.obj1.xml"
Private Function WriteLine(ByVal str As String)
Text1.Text = Text1.Text + str + vbNewLine
End Function
Private Function writeClear()
Text1.Text = ""
End Function
Private Function LoadXML(ByVal file As String)
' Read the input XML file and display the content in the text3.
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
xmldoc.setProperty "SelectionNamespaces", DSIGNS
LoadXML = True
End Function
Private Function SignXML(objID As String)
If xmldoc.xml = "" Then
WriteLine "Invalid signature template."
SignXML = False
Exit Function
End If
If keyContainer = "" Then
WriteLine "Invalid key container."
SignXML = False
Exit Function
End If
Set xmldsig.signature = xmldoc.selectSingleNode(".//ds:Signature")
Set oKey = xmldsig.createKeyFromCSP(provType, "", keyContainer, 0)
If oKey Is Nothing Then
WriteLine "Invalid key"
SignXML = False
Exit Function
End If
xpath = ".//ds:Object[@Id='" + objID + "']"
Set dataObj = xmldoc.selectSingleNode(xpath)
xmldsig.setReferenceData "#obj2", dataObj
Set oSignedKey = xmldsig.Sign(oKey, KEYVALUE)
If oSignedKey Is Nothing Then
WriteLine "sign failed."
SignXML = False
Exit Function
End If
WriteLine "The specified data was signed successfully."
WriteLine "Resultant signature: " + vbNewLine
WriteLine xmldoc.xml
output = App.Path + "\" + outfile
xmldoc.Save (output)
SignXML = True
End Function
Private Function VerifyXML(ByVal objID As String)
If xmldoc.xml = "" Then
WriteLine "Invalid XML signature file."
VerifyXML = False
Exit Function
End If
Set signature = xmldoc.selectSingleNode(".//ds:Signature")
If signature Is Nothing Then
WriteLine "Invalid <Signature> element"
VerifyXML = False
Exit Function
End If
Set xmldsig.signature = signature
Set oKeyInfo = xmldoc.selectSingleNode(".//ds:KeyInfo/ds:KeyValue")
If oKeyInfo Is Nothing Then
WriteLine "Invalid <KeyInfo> element."
VerifyXML = False
Exit Function
End If
Set oPubKey = xmldsig.createKeyFromNode(oKeyInfo)
If oPubKey Is Nothing Then
WriteLine "Can't generate public key for verification."
VerifyXML = False
Exit Function
End If
xpath = ".//ds:Object[@Id='" + objID + "']"
Set dataObj = xmldoc.selectSingleNode(xpath)
xmldsig.setReferenceData "#obj2", dataObj
Set oVerifiedKey = xmldsig.Verify(oPubKey)
If oVerifiedKey Is Nothing Then
WriteLine "Signature not verified."
End If
WriteLine "Signature verified on the data."
VerifyXML = True
End Function
Private Sub Form_Load()
'Set text box to use form to determine its width
'and height when form is loaded
Text1.Left = 100
Text1.Top = 100
Text1.Width = Form1.Width - 350
Text1.Height = Form1.Height - 750
provType = PROV_RSA_FULL
keyContainer = RSA_KEY
writeClear
WriteLine "Attempting to sign the object of 'obj1'." + vbNewLine
outfile = outfile1
If LoadXML(infile) = True Then
SignXML "obj1"
End If
If LoadXML(outfile) = True Then
VerifyXML "obj1"
End If
WriteLine vbNewLine
WriteLine "Attempting to sign the object of 'obj2'." + vbNewLine
outfile = outfile2
If LoadXML(infile) = True Then
SignXML "obj2"
End If
If LoadXML(outfile) = True Then
VerifyXML "obj2"
End If
End Sub
Private Sub Form_Resize()
'Set text box to use form in determining its width and height
'when form is resized
Text1.Width = Form1.Width - 350
Text1.Height = Form1.Height - 750
End Sub
Try It!