Attribute VB_Name = "TestFirmaSAT"
' $Id: TestFirmaSAT.bas $
'****************************** LICENSE ***********************************
' * Copyright (C) 2010-20 David Ireland, DI Management Services Pty Limited.
' * All rights reserved. <www.di-mgt.com.au> <www.cryptosys.net>
' * The code in this module is licensed under the terms of the MIT license.
' * For a copy, see <http://opensource.org/licenses/MIT>
' * Last updated:
' * $Date: 2020-08-05 23:31 $
' * $Version: 9.2.0 $
'****************************************************************************
'
' Some tests using the FirmaSAT VB6/VBA interface.
' Requires certain files to exist in the current working directory (see RequiredFilesExist()).
' Direct calls to the DLL begin with "SAT_"; wrapper functions begin with "sat" or "tfd"
' [v2.1] Added options for SHA-1 message digest algorithm
' [v3.0] Added new functions and support for CFDI version 3.0 XML documents
' [v4.0] Added support for selloSAT signatures in the TFD node. Removed dependency on CryptoSys PKI.
' [v4.1] Added SAT_FixBOM function.
' [v5.0] Added support for SAT version 2.2 and 3.2 docs. Added GetKeyAsString function.
' [v5.1] Added WritePfx and QueryCert functions.
' [v5.1.2] Added new test files for versions 2.2 and 3.2
' [v5.2] Added tests for `nomina` supplement and SAT_FILE_NO_BOM option
' [v5.4] Added SAT_Uuid() function and SAT_TFD option for SAT_SignXML().
' [v6.0] Added support for `Retenciones` documents.
' [v7.0] Added support for `Contabilidad` and `ConVol` documents.
' Added `BIGFILE` option to speed up the processing of large files.
' [v7.2] Added queries for key size and signature algorithm of X.509 certificates.
' Major updates to test filenames and associated tests.
' [v7.3] Added support for new Complementos.
' [v7.4] Removed support for MD5 algorithm.
' [v8.0] Added support for CFDiv3.3. New functions Asciify() and InsertCert().
' [v8.1] Added support for Contabilidad v1.3.
' [v8.2] Added advanced xpath search features for SAT_GetXmlAttribute.
' New function SAT_NewKeyFile. Updated test files.
' [v9.0] Added diagnostic method General.Comments(). Major changes in core XMLOK using bloom filter and regex.
' [v9.2] Improvements in handling VBA Unicode strings.
Option Explicit
Option Base 0
Public Const MIN_VERSION As Long = 90200
Public Sub General_Tests()
Dim n As Long
Dim i As Long
Dim j As Long
Dim s As String
Dim s1 As String
Dim ch As String
Dim fname As String
Dim newname As String
Dim keyfile As String
Dim certfile As String
Dim password As String
Dim newpassword As String
Dim attributeName As String
Dim elementName As String
Dim eName As String
Dim hasBOM As Boolean
Dim xmlstring As String
Dim newstring As String
Dim digest As String
Dim query As String
Dim dig1 As String
Dim dig2 As String
Dim certfiledata As String
Dim keyfiledata As String
Dim xbase As String
Dim xpath As String
Dim xpath1 As String
Dim xmlbytes() As Byte
Dim isok As Boolean
' Check if all required test files exist in the CWD
If Not RequiredFilesExist() Then
MsgBox "Required test file cannot be found in current working directory: " & CurDir, vbCritical
Exit Sub
End If
Debug.Print ("INTERROGATE THE CORE DIFIRMASAT DLL:")
n = SAT_Version()
Debug.Print "Version=" & n
If n < MIN_VERSION Then
MsgBox "Require FirmaSAT v" & MIN_VERSION & " or higher", vbCritical
Exit Sub
End If
ch = Chr(SAT_LicenceType())
Debug.Print "LicenceType=" & ch
Debug.Print "ModuleName=" & satModuleName()
Debug.Print "CompileTime=" & satCompileTime()
Debug.Print "Comments=" & satComments()
Debug.Print (vbLf & "FORM THE PIPESTRING FROM AN XML FILE:")
fname = "cfdv33a-base.xml"
s = satMakePipeStringFromXml(fname)
Debug.Print "MakePipeStringFromXml(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "SIGN AN XML FILE:")
fname = "cfdv33a-base.xml"
newname = "cfdv33a_new-signed.xml"
keyfile = "emisor.key"
password = "12345678a" ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
certfile = "emisor.cer"
n = SAT_SignXml(newname, fname, keyfile, password, certfile, 0)
Debug.Print "SAT_SignXml('" & fname & "'-->'" & newname & "') returns " & n
Debug.Assert (n = 0)
' Did we make a valid XML file?
n = SAT_ValidateXml(newname, 0)
Debug.Print "SAT_ValidateXml(" & newname & ") returns " & n
Debug.Assert (n = 0)
Debug.Print (vbLf & "VERIFY A SIGNATURE IN AN XML FILE:")
Debug.Print ("1. One we know is good:")
fname = "cfdv33a-signed-tfd.xml"
n = satVerifySignature(fname)
Debug.Print "SAT_VerifySignature(" & fname & ") returns " & n
Debug.Assert (n = 0)
Debug.Print ("2. One we just made, so it should be good:")
fname = newname
n = satVerifySignature(fname)
Debug.Print "SAT_VerifySignature(" & fname & ") returns " & n
Debug.Assert (n = 0)
Debug.Print (vbLf & "FORM THE DIGEST OF THE PIPESTRING IN AN XML FILE:")
fname = "cfdv33a-base.xml"
s = satMakeDigestFromXml(fname)
Debug.Print "MakeDigestFromXml(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "EXTRACT THE DIGEST FROM THE SIGNATURE IN AN XML FILE:")
fname = "cfdv33a-signed-tfd.xml"
s1 = satExtractDigestFromSignature(fname)
Debug.Print "ExtractDigestFromSignature(" & fname & ")=" & vbLf & s1
Debug.Assert (Len(s1) > 0)
Debug.Assert (StrComp(s1, s, vbTextCompare) = 0)
Debug.Print (vbLf & "TRY VALIDATING STRUCTURE OF XML FILES:")
Debug.Print ("1. A valid one:")
fname = "cfdv33a-signed-tfd.xml"
n = SAT_ValidateXml(fname, 0)
Debug.Print "SAT_ValidateXml(" & fname & ") returns " & n
Debug.Assert (n = 0)
Debug.Print ("2. An invalid one (missing version):")
fname = "cfdv33a-bad-nover.xml"
n = SAT_ValidateXml(fname, 0)
Debug.Print "SAT_ValidateXml(" & fname & ") returns " & n
s = satLastError()
Debug.Print "ErrorLookup(" & n & ")=" & satErrorLookup(n)
Debug.Print "LastError=" & s
Debug.Print (vbLf & "EXTRACT AN ATTRIBUTE FROM AN XML FILE:")
fname = "cfdv33a-signed-tfd.xml"
elementName = "Comprobante"
attributeName = "Sello" ' NB Capital letter 'S'
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "GET DETAILS OF X.509 CERTIFICATE:")
Debug.Print ("1. From embedded `certificado` in XML")
fname = "cfdv33a-signed-tfd.xml"
s = satGetCertNumber(fname)
Debug.Print "GetCertNumber(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
s = satGetCertExpiry(fname)
Debug.Print "GetCertExpiry(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print ("2. From X.509 certificate file")
fname = "emisor.cer"
s = satGetCertNumber(fname)
Debug.Print "GetCertNumber(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
s = satGetCertExpiry(fname)
Debug.Print "GetCertExpiry(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "GET CERTIFICATE AS A BASE64 STRING:")
fname = "emisor.cer"
s = satGetCertAsString(fname)
Debug.Print "GetCertAsString(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print "Len(GetCertAsString(" & fname & "))=" & Len(s)
' Compare against string from XML file
fname = "cfdv33a-signed-tfd.xml"
s1 = satGetCertAsString(fname)
Debug.Print "Len(GetCertAsString(" & fname & "))=" & Len(s1)
Debug.Assert (Len(s1) > 0)
Debug.Assert (StrComp(s, s1, vbTextCompare) = 0)
Debug.Print (vbLf & "MAKE A SIGNATURE FROM A BASE XML FILE:")
fname = "cfdv33a-base.xml"
keyfile = "emisor.key"
password = "12345678a" ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
s = satMakeSignatureFromXml(fname, keyfile, password)
Debug.Print "MakeSignatureFromXml(" & fname & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "SIGN A DETALLISTA XML FILE:")
fname = "cfdv33a-detallista.xml"
newname = "detallista_new-signed.xml"
keyfile = "emisor.key"
password = "12345678a"
' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
certfile = "emisor.cer"
n = SAT_SignXml(newname, fname, keyfile, password, certfile, 0)
Debug.Print "SAT_SignXml('" & fname & "'-->'" & newname & "') returns " & n
Debug.Assert (n = 0)
' Did we make a valid XML file?
n = SAT_ValidateXml(newname, 0)
Debug.Print "SAT_ValidateXml(" & newname & ") returns " & n
Debug.Assert (n = 0)
n = satVerifySignature(newname)
Debug.Print "SAT_VerifySignature(" & newname & ") returns " & n
Debug.Assert (n = 0)
Debug.Print (vbLf & "EXTRACT AN ATTRIBUTE FROM A DETALLISTA XML FILE:")
fname = "cfdv33a-detallista.xml"
elementName = "detallista:detallista"
attributeName = "documentStructureVersion"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Assert (StrComp(s, "AMC8.1") = 0)
Debug.Print (vbLf & "EXTRACT AN ATTRIBUTE WITH ACCENTED CHARACTERS:")
fname = "cfdv33a-base.xml"
elementName = "cfdi:Emisor"
attributeName = "Nombre"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "EXTRACT AN ATTRIBUTE WITH ACCENTED CHARACTERS IN ITS NAME:")
fname = "cfdv33a-nomina12.xml"
elementName = "nomina12:CompensacionSaldosAFavor"
attributeName = "Año"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "CHECK PRIVATE KEY MATCHES PUBLIC KEY IN CERTIFICATE:")
certfile = "emisor.cer"
keyfile = "emisor.key"
password = "12345678a" ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
n = SAT_CheckKeyAndCert(keyfile, password, certfile, 0)
Debug.Print "SAT_CheckKeyAndCert(" & keyfile & "," & certfile & ")=" & n
Debug.Assert (n = 0)
certfile = "pac.cer"
keyfile = "pac.key"
password = "12345678a"
n = SAT_CheckKeyAndCert(keyfile, password, certfile, 0)
Debug.Print "SAT_CheckKeyAndCert(" & keyfile & "," & certfile & ")=" & n
Debug.Assert (n = 0)
' Get embedded certificate from XML doc
certfile = "cfdv33a-signed-tfd.xml"
keyfile = "emisor.key"
password = "12345678a"
n = SAT_CheckKeyAndCert(keyfile, password, certfile, 0)
Debug.Print "SAT_CheckKeyAndCert(" & keyfile & "," & certfile & ")=" & n
Debug.Assert (n = 0)
Debug.Print (vbLf & "GET RECEIPT (COMPROBANTE) VERSION NUMBER FROM XML FILE:")
fname = "cfdv33a-base.xml"
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion(" & fname & ")=" & n
Debug.Assert (33 = n)
' Older version...
fname = "ejemplo_v32-tfd2015.xml"
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion(" & fname & ")=" & n
Debug.Assert (32 = n)
Debug.Print (vbLf & "CREATE CADENA ORIGINAL DEL TIMBRE FISCAL DIGITAL (PIPESTRING FOR TFD):")
fname = "cfdv33a-signed-tfd.xml"
s = tfdMakePipeStringFromXml(fname)
Debug.Print "tfdMakePipeStringFromXml(" & fname & ")=" & vbCrLf & s
Debug.Print (vbLf & "FORM DIGEST OF PIPESTRING FOR TFD:")
fname = "cfdv33a-signed-tfd.xml"
s = tfdMakeDigestFromXml(fname)
Debug.Print "tfdMakeDigestFromXml(" & fname & ")=" & vbCrLf & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "EXTRACT DIGEST FROM TFD SELLOSAT:")
certfile = "pac.cer"
s1 = tfdExtractDigestFromSignature(fname, certfile)
Debug.Print "tfdExtractDigestFromSignature(" & fname & ")=" & vbCrLf & s1
Debug.Assert (Len(s1) > 0)
Debug.Assert (StrComp(s1, s, vbTextCompare) = 0)
Debug.Print (vbLf & "PRETEND WE ARE A PAC WITH A KEY ALLOWED TO SIGN THE TFD:")
' so create a TFD signature string we could paste into the `selloSAT' node
fname = "cfdv33a-signed-tfd.xml"
keyfile = "pac.key"
password = "12345678a"
s = tfdMakeSignatureFromXml(fname, keyfile, password)
Debug.Print "tfdMakeSignatureFromXml(" & fname & ", " & keyfile & ")=" & vbCrLf & s
Debug.Assert (Len(s) > 0)
' Get the correct string from the TFD node
' NB Capital 'S' for Sello in TFD v1.1
s1 = satGetXmlAttribute(fname, "SelloSAT", "TimbreFiscalDigital")
Debug.Print "Correct=" & vbCrLf & s1
Debug.Assert (StrComp(s1, s, vbTextCompare) = 0)
Debug.Print (vbLf & "VERIFY SIGNATURE IN TFD SELLOSAT:")
fname = "cfdv33a-signed-tfd.xml"
certfile = "pac.cer"
n = tfdVerifySignature(fname, certfile)
Debug.Print "tfdVerifySignature(" & fname & ", " & certfile & ")=" & n & " (expected 0)"
Debug.Assert (n = 0)
Debug.Print (vbLf & "ADD A TFD ELEMENT TO A SIGNED CFDI DOCUMENT USING PAC KEY:")
fname = "cfdv33a-signed.xml"
newname = "cfdv33a_new-tfd.xml"
certfile = "pac.cer"
keyfile = "pac.key"
password = "12345678a"
n = SAT_SignXml(newname, fname, keyfile, password, certfile, SAT_TFD)
Debug.Assert (n = 0)
' Did we make a valid XML file?
n = SAT_ValidateXml(newname, 0)
Debug.Print "SAT_ValidateXml(" & newname & ")=" & n
Debug.Assert (n = 0)
' Does it have a valid selloSAT?
n = tfdVerifySignature(newname, certfile)
Debug.Print "tfdVerifySignature(" & newname & ")=" & n
Debug.Assert (n = 0)
Debug.Print (vbLf & "ADD UTF-8 BOM TO EXISTING FILE:")
fname = "cfdv33a-signed-nobom.xml"
newname = "cfdv33a_new-signed-with-BOM"
n = SAT_FixBOM(newname, fname, 0)
Debug.Print "SAT_FixBOM(" & fname & "->" & newname & ")=" & n & " (expected 0)"
Debug.Assert (n = 0)
Debug.Print (vbLf & "EXTRACT ATTRIBUTES FROM CONSECUTIVE ELEMENTS:")
fname = "ejemplo_v32-tfd2015.xml"
attributeName = "descripcion"
elementName = "cfdi:Concepto"
For i = 1 To 100
eName = elementName & "[" & i & "]"
s = satGetXmlAttribute(fname, attributeName, eName)
Debug.Print "satGetXmlAttribute(" & attributeName & ", " & eName & ")='" & s & "'"
If Len(s) = 0 Then
Exit For
End If
Next
Debug.Print (vbLf & "VALIDATE XML WITH STRICT AND LOOSE OPTIONS:")
fname = "V3_2_BadCurp.xml"
Debug.Print "Default strict behaviour (badly formed CURP attribute)"
n = SAT_ValidateXml(fname, 0)
Debug.Print "SAT_ValidateXml('" & fname & "') returns " & n
s = satLastError()
Debug.Print "ErrorLookup(" & n & ")=" & satErrorLookup(n)
Debug.Print "LastError=" & s
Debug.Assert (n <> 0)
Debug.Print "Using LOOSE option:"
n = SAT_ValidateXml(fname, SAT_XML_LOOSE)
Debug.Print "SAT_ValidateXml('" & fname & "', LOOSE) returns " & n
Debug.Assert (n = 0)
Debug.Print (vbLf & "GET PRIVATE KEY AS BASE64:")
fname = "emisor.key"
s = satGetKeyAsString(fname, "12345678a")
Debug.Print "GetCertAsString(" & fname & ")=" & vbLf & s
Debug.Print "Len(satGetKeyAsString(" & fname & "))=" & Len(s)
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "WRITE PFX FROM PRIVATE KEY AND CERT:")
certfile = "emisor.cer"
keyfile = "emisor.key"
password = "12345678a"
fname = "archivo_new-pfx.txt"
newpassword = "clavedesalida"
n = SAT_WritePfxFile(fname, newpassword, keyfile, password, certfile, 0)
Debug.Print "Sat.WritePfxFile()->" & fname & " returns " & n
Debug.Assert (n = 0)
Debug.Print "New PFX file is " & FileLen(fname) & " bytes long."
Debug.Print (vbLf & "GET RFC AND ORG NAME FROM CERT:")
' From X.509 certificate file
fname = "emisor.cer"
Debug.Print "FILE: " & fname
s = satQueryCert(fname, "rfc")
Debug.Print "satQueryCert(rfc)="; s
Debug.Assert (Len(s) > 0)
s = satQueryCert(fname, "organizationName")
Debug.Print "satQueryCert(organizationName)='" & s & "'"
Debug.Assert (Len(s) > 0)
' From embedded `certificado` in XML
fname = "cfdv33a-signed-tfd.xml"
Debug.Print "FILE: " & fname
s = satQueryCert(fname, "rfc")
Debug.Print "satQueryCert(rfc)=" & s
Debug.Assert (Len(s) > 0)
s = satQueryCert(fname, "organizationName")
Debug.Print "satQueryCert(organizationName)='" & s & "'"
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "TEST OTHER QUERIES FOR CERT:")
fname = "emisor.cer"
Debug.Print "FILE: " & fname
s = satQueryCert(fname, "notBefore")
Debug.Print "satQueryCert(notBefore)=" & s
Debug.Assert (Len(s) > 0)
s = satQueryCert(fname, "notAfter")
Debug.Print "satQueryCert(notAfter)=" & s
Debug.Assert (Len(s) > 0)
s = satQueryCert(fname, "serialNumber")
Debug.Print "satQueryCert(serialNumber)=" & s
Debug.Assert (Len(s) > 0)
Debug.Print (vbLf & "READ ENCRYPTED PRIVATE KEY FILE AS PEM STRING:")
keyfile = "emisor.key"
s = satGetKeyAsPEMString(keyfile, "12345678a")
Debug.Print "Key file '" & keyfile & "' in PEM form:"
Debug.Print s
Debug.Print (vbLf & "SIGN XML TO STRING:")
' Read an XML file into a string
' [v9.2] CHANGE - always use satAsciify to read in a file to a VBA Unicode string
fname = "cfdv33a-base.xml"
xmlstring = satAsciify(fname)
Debug.Print "String from file '" & fname & "' has " & Len(xmlstring) & " bytes"
' We can pass key file and certificate as "PEM" strings.
' The "BEGIN/END" encapsulation is optional for a certificate,
' but is required for the encrypted private key.
' These strings are from `emisor-pem.cer` and `emisor-pem.key`, respectively
certfiledata = _
"-----BEGIN CERTIFICATE-----" & _
"MIIF+TCCA+GgAwIBAgIUMzAwMDEwMDAwMDAzMDAwMjM3MDgwDQYJKoZIhvcNAQELBQAwggFmMSAwHgYDVQQDDBdBLkMuIDIgZGUgcHJ1ZWJhcyg0MDk2KTEvMC0GA1UECgwmU2VydmljaW8gZGUgQWRtaW5pc3RyYWNpw7NuIFRyaWJ1dGFyaWExODA2BgNVBAsML0FkbWluaXN0cmFjacOzbiBkZSBTZWd1cmlkYWQgZGU" & _
"gbGEgSW5mb3JtYWNpw7NuMSkwJwYJKoZIhvcNAQkBFhphc2lzbmV0QHBydWViYXMuc2F0LmdvYi5teDEmMCQGA1UECQwdQXYuIEhpZGFsZ28gNzcsIENvbC4gR3VlcnJlcm8xDjAMBgNVBBEMBTA2MzAwMQswCQYDVQQGEwJNWDEZMBcGA1UECAwQRGlzdHJpdG8gRmVkZXJhbDESMBAGA1UEBwwJQ295b2Fjw6FuMRUwEw" & _
"YDVQQtEwxTQVQ5NzA3MDFOTjMxITAfBgkqhkiG9w0BCQIMElJlc3BvbnNhYmxlOiBBQ0RNQTAeFw0xNzA1MTgwMzU0NTZaFw0yMTA1MTgwMzU0NTZaMIHlMSkwJwYDVQQDEyBBQ0NFTSBTRVJWSUNJT1MgRU1QUkVTQVJJQUxFUyBTQzEpMCcGA1UEKRMgQUNDRU0gU0VSVklDSU9TIEVNUFJFU0FSSUFMRVMgU0MxKTAnB" & _
"gNVBAoTIEFDQ0VNIFNFUlZJQ0lPUyBFTVBSRVNBUklBTEVTIFNDMSUwIwYDVQQtExxBQUEwMTAxMDFBQUEgLyBIRUdUNzYxMDAzNFMyMR4wHAYDVQQFExUgLyBIRUdUNzYxMDAzTURGUk5OMDkxGzAZBgNVBAsUEkNTRDAxX0FBQTAxMDEwMUFBQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAJdUcsHIEIgw" & _
"ivvAantGnYVIO3+7yTdD1tkKopbL+tKSjRFo1ErPdGJxP3gxT5O+ACIDQXN+HS9uMWDYnaURalSIF9COFCdh/OH2Pn+UmkN4culr2DanKztVIO8idXM6c9aHn5hOo7hDxXMC3uOuGV3FS4ObkxTV+9NsvOAV2lMe27SHrSB0DhuLurUbZwXm+/r4dtz3b2uLgBc+Diy95PG+MIu7oNKM89aBNGcjTJw+9k+WzJiPd3ZpQgI" & _
"edYBD+8QWxlYCgxhnta3k9ylgXKYXCYk0k0qauvBJ1jSRVf5BjjIUbOstaQp59nkgHh45c9gnwJRV618NW0fMeDzuKR0CAwEAAaMdMBswDAYDVR0TAQH/BAIwADALBgNVHQ8EBAMCBsAwDQYJKoZIhvcNAQELBQADggIBABKj0DCNL1lh44y+OcWFrT2icnKF7WySOVihx0oR+HPrWKBMXxo9KtrodnB1tgIx8f+Xjqyphh" & _
"bw+juDSeDrb99PhC4+E6JeXOkdQcJt50Kyodl9URpCVWNWjUb3F/ypa8oTcff/eMftQZT7MQ1Lqht+xm3QhVoxTIASce0jjsnBTGD2JQ4uT3oCem8bmoMXV/fk9aJ3v0+ZIL42MpY4POGUa/iTaawklKRAL1Xj9IdIR06RK68RS6xrGk6jwbDTEKxJpmZ3SPLtlsmPUTO1kraTPIo9FCmU/zZkWGpd8ZEAAFw+ZfI+bdXBf" & _
"vdDwaM2iMGTQZTTEgU5KKTIvkAnHo9O45SqSJwqV9NLfPAxCo5eRR2OGibd9jhHe81zUsp5GdE1mZiSqJU82H3cu6BiE+D3YbZeZnjrNSxBgKTIf8w+KNYPM4aWnuUMl0mLgtOxTUXi9MKnUccq3GZLA7bx7Zn211yPRqEjSAqybUMVIOho6aqzkfc3WLZ6LnGU+hyHuZUfPwbnClb7oFFz1PlvGOpNDsUb0qP42QCGBiTU" & _
"seGugAzqOP6EYpVPC73gFourmdBQgfayaEvi3xjNanFkPlW1XEYNrYJB4yNjphFrvWwTY86vL2o8gZN0Utmc5fnoBTfM9r2zVKmEi6FUeJ1iaDaVNv47te9iS1ai4V4vBY8r" & _
"-----END CERTIFICATE-----"
keyfiledata = _
"-----BEGIN ENCRYPTED PRIVATE KEY-----" & _
"MIIFDjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQI5qDMtGWYa2wCAggAMBQGCCqGSIb3DQMHBAhFAqj+c0f8JASCBMhNUpNUp57vMu8L3LHBKRBTFl0VE3oqBIEKBHFYYz063iiS0Y3tPW3cplLTSqG25MdbIQcHCxwmPVYNdetHUjqjeR+TklWgtnMbLqvdMmmRxAFuHXznHFIa4U+YNedhFm7sdR2DsGFijm3" & _
"vIpUbvpILtpTrhog/EHAvZXV6+F86cYc9+LUg3d0DRwJc+sWmk+2xOoXvOvvpnnQqfhQxkSknfITmc+HAWgHbKLK2q6e2RixjpWn0sA9LslYD0ZDn5uhrce+QEfK97asraFfiteqXf2Ll8B54Ku/er+O2JEu62vVDFumwMtZOuHKH4NbjOmMzKIwRTKp/1jp6OTGYSKIRiTDXnTETJwgItHahf7UAoM/qnkJa17Ood4hiCY" & _
"opMyCXdhyMDJoFhWRanQODaiocb7XpMm1SEpTtHZeKgEVWSc/obYgSgs4iY497UR2MUVZQSCBdRXCgs5g1c31cCwAZ6r41KMoLOBVLtRXoT0mc0D6ovlwYuJhqYvuwjdNkWJS7qwXuy8b2ux4t027NGUXmgtb9XQDm8yJrdTtm0CktWPKe7i2tQtBC2tAjduGAlBrzY+whySRN8KUJQbYKhOBaLXgEPI93wi/SKHJO13Wvf" & _
"qqjKqrqJwB3tvhjz5E1uDKmDFoivdS76uq+k/xpmF5OWBmypWNViw7kgvmH1OeTBKYkUHIL85skL6pdycGnTk3g0AmG9xtPYu6pdSqUv+N8QmTdmmdu85fDEN0fk2t2BRPANsbIqxopVfj5qIwm+8TbZDdNj8OssxrC5sRy5yDBjV4J+x253yaILn7wgUR6Yj6GaHUUF4GISmFZ/PTbnVPDd424w6hGV8NKtUHXq5ms2kJX" & _
"o6XGiGqjbdePM53QhdSrxTM5Dt76RcAInky6w5s/7gvT/w7tdbVA/SPhp4xgaT8Crmjbk3upcSqNI0HuROBxOs0gRRAWXScUZJ0Vd1V0F+C5cG2R1CtGTYeRmIAwLwcWf6DjY1Q+TOe/W3eTatOo+gIozjYDCk5ZNfeQzq4p1ApN6+gzS8kNxtvKOYJogjV74RK/Xl7u7oLv4SZT7Nl1YRpScW1ouIcNNTP0AC+j2OFZ3Yu" & _
"eN8CcmvXbgSW8pYRooTxnFfo9sdOL624uwRyb2DwwLO0Vo3aBIEIf8sm9sqocXmwh9sxFPEbTXPCuMSao8QjyBOlsCem2589NVZs0h0ipGwdbatcjkgf+hzRoYBdlvHtKHJ8gL/A/Ap8z0+TK5NaVWUA+zXOZRZ66NYfs18DEbJKjwOcnnsLcfAMYoSn697148sL4JBv8IOmM6QXfxCl/0yU0d5/876L5jOL56lfH0eBk8s" & _
"2nioAl3yRBl2wlihWi39sA0bsdHFKYEX+LqPBBCAdxZAvXCCJcdEdxOXSgEiFAmW9+IXFT/WJeGcZ4OmCd3Qf0fxGqFXA/9hIUumWde6s0wN8LjXuFZQaMDaaVIGXKguP3OijsfBF0PYzI+L6CfUi2BLaYNJTlbQxbncmW2PKeDiypgt3ZY1PKV66o5OAJEAkV3vf9cRwXE5T8GwZHA+wx2rWC98hkH15xfI9qEsYulVdcX" & _
"WzCF58HFQjUoDon0e/QMukS0eNgq9ipmoKAWKyy7+TQw7Xx3MmqkGlLHGM=" & _
"-----END ENCRYPTED PRIVATE KEY-----"
password = "12345678a"
' Check key and certificate are matched
n = SAT_CheckKeyAndCert(keyfiledata, password, certfiledata, 0)
Debug.Print "SAT_CheckKeyAndCert(STRINGS)=" & n
Debug.Assert (n = 0)
' Create a new string containing signed XML (UTF-8-encoded)
' [OLD METHOD NOW DEPRECATED] - see satSignXmlToBytes() below
newstring = satSignXmlToString(xmlstring, keyfiledata, password, certfiledata, 0)
Debug.Print "Signed XML string has " & Len(newstring) & " bytes:"
' Note this string contains UTF-8-encoded characters including a BOM which print "funny"
Debug.Print Left(newstring, 120) & "..." & vbCrLf & "..." & vbCrLf & Right(newstring, 320)
' Save string as a file (UTF-8 encoded)
Call WriteFileFromString("fromstring_new.xml", newstring)
Debug.Print (vbLf & "PASS XML STRING TO OTHER SAT FUNCTIONS:")
' We can pass this string as an `szXmlFile` parameter to other SAT_ functions
n = SAT_ValidateXml(newstring, 0)
Debug.Print "SAT_ValidateXml(string) returns " & n
Debug.Assert (n = 0)
n = SAT_XmlReceiptVersion(newstring, 0)
Debug.Print "SAT_XmlReceiptVersion(string) returns " & n
Debug.Print (vbLf & "SIGN XML USING EMPTY-ELEMENT TAGS:")
newstring = satSignXmlToString(xmlstring, keyfile, password, certfile, SAT_XML_EMPTYELEMTAG)
Debug.Print "Signed XML string has " & Len(newstring) & " bytes:"
Debug.Print Left(newstring, 120) & "..." & vbCrLf & "..." & vbCrLf & Right(newstring, 262)
n = SAT_ValidateXml(newstring, 0)
Debug.Print "SAT_ValidateXml(string) returns " & n
Debug.Assert (n = 0)
Call WriteFileFromString("fromstring_new-emptyelems.xml", newstring)
Debug.Print (vbLf & "GENERATE 3 UUIDs:")
s = satUuid()
Debug.Print "UUID=" & s
s = satUuid()
Debug.Print "UUID=" & s
s = satUuid()
Debug.Print "UUID=" & s
' New in [v6.0]
Debug.Print vbLf & "WORK WITH A `RETENCIONES` DOCUMENT:"
fname = "Ejemplo_Retenciones-base.xml"
Debug.Print "FILE=" & fname
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion() returns " & n & " (expecting 1010)"
Debug.Assert (1010 = n)
s = satMakeDigestFromXml(fname)
Debug.Print "satMakeDigestFromXml -> " & s
Debug.Assert (Len(s))
' Use new [v6.0] arguments to find name of root element
s = satGetXmlAttribute(fname, "", "")
Debug.Print "Document root element is '" & s & "'"
Debug.Assert (Len(s))
' New in [v7.0]
Debug.Print vbLf & "WORK WITH `CONTABILIDAD` DOCUMENTS:"
fname = "AAA010101AAA201501CT-base.xml"
Debug.Print "CATALOGOCUENTAS FILE=" & fname
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion() returns " & n & " (expecting 2011)"
Debug.Assert (2011 = n)
Debug.Print "SIGN A CATALOGOCUENTAS DOCUMENT...:"
newname = "AAA010101AAA201501CT_new.xml"
keyfile = "emisor.key"
certfile = "emisor.cer"
password = "12345678a" ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
n = SAT_SignXml(newname, fname, keyfile, password, certfile, 0)
Debug.Print "SAT_SignXml() returns " & n & " (expecting 0)"
Debug.Assert (0 = n)
n = SAT_VerifySignature(newname, "", 0)
Debug.Print "SAT_VerifySignature() returns " & n & " (expecting 0)"
Debug.Assert (0 = n)
fname = "AAA010101AAA201501BN-base.xml"
Debug.Print "BALANZA FILE=" & fname
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion() returns " & n & " (expecting 2111)"
Debug.Assert (2111 = n)
Debug.Print "MAKE THE SIGNATURE STRING FOR BALANZA...:"
s = satMakeSignatureFromXml(fname, keyfile, password)
Debug.Print "satMakeSignatureFromXml -> " & vbLf & s
Debug.Assert (Len(s) > 0)
fname = "contab-SelloDigitalContElec-signed.xml"
Debug.Print "SELLODIGITALCONTELEC FILE=" & fname
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion() returns " & n & " (expecting 2511)"
Debug.Assert (2511 = n)
Debug.Print "VERIFY SIGNATURE FOR SELLODIGITALCONTELEC USING PAC CERTIFICATE...:"
n = SAT_VerifySignature(fname, "pac1024.cer", 0)
Debug.Print "SAT_VerifySignature() returns " & n & " (expecting 0)"
Debug.Assert (0 = n)
Debug.Print vbLf & "WORK WITH `CONTROLESVOLUMETRICOS` DOCUMENT:"
fname = "ConVolE12345-base.xml"
Debug.Print "FILE=" & fname
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion() returns " & n & " (expecting 4011)"
Debug.Assert (4011 = n)
Debug.Print "SIGN A CONVOL DOCUMENT WITH BIGFILE FLAG...:"
newname = "ConVolE12345_new-signed.xml"
' Use key and cert provided for ConVol tests
keyfile = "CSD_E12345CV_ACP020530MP5.key"
certfile = "CSD_E12345CV_ACP020530MP5.cer"
password = "12345678a" ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
n = SAT_SignXml(newname, fname, keyfile, password, certfile, SAT_FILE_BIGFILE)
Debug.Print "SAT_SignXml(BIGFILE) returns " & n & " (expecting 0)"
Debug.Assert (0 = n)
n = SAT_VerifySignature(newname, "", 0)
Debug.Print "SAT_VerifySignature() returns " & n & " (expecting 0)"
Debug.Assert (0 = n)
Debug.Print vbLf & "QUERY KEY SIZE OF CERTIFICATES..."
query = "keySize"
fname = "emisor1024.cer"
s = satQueryCert(fname, query)
Debug.Print "satQueryCert('" & fname & "'," & query & ")=" & s
Debug.Assert (Len(s) > 0)
fname = "emisor.cer"
s = satQueryCert(fname, query)
Debug.Print "satQueryCert('" & fname & "'," & query & ")=" & s
Debug.Assert (Len(s) > 0)
fname = "AC4_SAT.cer"
s = satQueryCert(fname, query)
Debug.Print "satQueryCert('" & fname & "'," & query & ")=" & s
Debug.Assert (Len(s) > 0)
Debug.Print vbLf & "QUERY SIGNATURE ALGORITHM IN CERTIFICATES..."
query = "sigAlg"
fname = "emisor1024.cer"
s = satQueryCert(fname, query)
Debug.Print "satQueryCert('" & fname & "'," & query & ")=" & s
Debug.Assert (Len(s) > 0)
fname = "emisor.cer"
s = satQueryCert(fname, query)
Debug.Print "satQueryCert('" & fname & "'," & query & ")=" & s
Debug.Assert (Len(s) > 0)
Debug.Print vbLf & "READ IN XML DOC AS 'ASCIIFIED' STRING..."
' "Esta es una demostración" -> "Esta es una demostración"
fname = "cfdv33a-base.xml"
xmlstring = satAsciify(fname)
Debug.Print "ASCIIFIED XML:"
Debug.Print xmlstring
' Extract an attribute from the XML string
s = satGetXmlAttribute(xmlstring, "Nombre", "cfdi:Emisor")
Debug.Print "cfdi:Emisor/@Nombre=[" & s & "]"
' Compute digest from XML string
dig1 = satMakeDigestFromXml(xmlstring)
Debug.Print "DIG(str) =" & dig1
' -- this should match the digest of the original UTF-8-encoded file
dig2 = satMakeDigestFromXml(fname)
Debug.Print "DIG(file)=" & dig2
Debug.Assert (StrComp(dig1, dig2, vbTextCompare) = 0)
Debug.Print vbLf & "INSERT CERTIFICATE DETAILS INTO XML..."
fname = "cfdv33a-base-nocertnum.xml"
newname = "cfdv33a-base_new-pluscert.xml"
certfile = "emisor.cer"
n = SAT_InsertCert(newname, fname, certfile, 0)
Debug.Print "SAT_InsertCert() returns " & n & " (expecting 0)"
Debug.Assert (0 = n)
' Check noCertificado just inserted
' Original should be empty
s = satGetXmlAttribute(fname, "NoCertificado", "cfdi:Comprobante")
Debug.Print "Old NoCertificado=[" & s & "]"
s = satGetXmlAttribute(newname, "NoCertificado", "cfdi:Comprobante")
Debug.Print "New NoCertificado=[" & s & "]"
Debug.Assert (Len(s) > 0)
Debug.Print vbLf & "INSERT CERTIFICATE DETAILS INTO XML AS STRING..."
newstring = satInsertCertToString(fname, certfile)
Debug.Assert (Len(newstring) > 0)
' Extract new attribute from XML as string
s = satGetXmlAttribute(newstring, "NoCertificado", "cfdi:Comprobante")
Debug.Assert (Len(s) > 0)
Debug.Print "New noCertificado=[" & s & "]"
Debug.Print vbLf & "SUPPORT FOR CONTABILIDAD V1.3..."
fname = "AAA010101AAA201705CT.xml"
Debug.Print "FILE: " & fname
s = satGetXmlAttribute(fname, "", "")
Debug.Print "Doc type is '" & s & "'"
n = SAT_ValidateXml(fname, 0)
Debug.Print "Sat_ValidateXml() returns " & n & " (0 => OK)"
Debug.Assert (0 = n)
n = SAT_VerifySignature(fname, "", 0)
Debug.Print "SAT_VerifySignature() returns " & n & " (0 => OK)"
Debug.Assert (0 = n)
n = SAT_XmlReceiptVersion(fname, 0)
Debug.Print "SAT_XmlReceiptVersion() returns " & n & " (expecting 2013)"
' Get default digest algorithm for this document type (a hack!)
n = SAT_XmlReceiptVersion(fname, SAT_GEN_DIGALG)
Debug.Print "Default digest algorithm is SHA-" & n
Debug.Print vbLf & "SAVE KEYFILE WITH NEW PASSWORD..."
keyfile = "emisor.key"
password = "12345678a"
newname = "emisor_new.key"
newpassword = "password123"
n = SAT_NewKeyFile(newname, newpassword, keyfile, password, "", 0)
Debug.Print "SAT_NewKeyFile() returns " & n & " (0 => OK)"
Debug.Assert (0 = n)
Debug.Print "Created new key file of length " & FileLen(newname) & " bytes with password '" & newpassword & "'"
Debug.Print "Save again in PEM format..."
newname = "emisor_new.pem"
newpassword = "password456"
n = SAT_NewKeyFile(newname, newpassword, keyfile, password, "", SAT_FORMAT_PEM)
Debug.Print "SAT_NewKeyFile() returns " & n & " (0 => OK)"
Debug.Assert (0 = n)
Debug.Print "Created new key file of length " & FileLen(newname) & " bytes with password '" & newpassword & "'"
Debug.Print "Check new key still matches old certificate..."
n = SAT_CheckKeyAndCert(newname, newpassword, certfile, 0)
Debug.Print "SAT_CheckKeyAndCert() returns " & n & " (0 => OK)"
Debug.Assert (0 = n)
Debug.Print vbLf & "XPATH EXPRESSIONS FOR XML-GET-ATTRIBUTE..."
fname = "A7.xml"
Debug.Print "FILE: " & fname
elementName = "/Comprobante"
attributeName = "Version"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
elementName = "/Comprobante/Conceptos/Concepto[2]/Impuestos/Traslados/Traslado[1]"
attributeName = "Importe"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
elementName = "/Comprobante/Conceptos/Concepto[1]/Impuestos/Retenciones/Retencion[2]"
attributeName = "Importe"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
' Same as above but shorter
elementName = "//Conceptos/Concepto[1]//Retencion[2]"
attributeName = "Importe"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
' Test for element's existence (and fail)
elementName = "/Comprobante/Conceptos/Concepto[3]"
attributeName = ""
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
' Expecting empty string and LastError to include "!NO MATCH!"
If (Len(s) = 0) Then
Debug.Print satLastError()
End If
Debug.Assert (Len(s) = 0 And InStr(1, satLastError(), "!NO MATCH!") > 0)
Debug.Print vbLf & "USE XPATH TO FIND ALL ATTRIBUTES NAMED 'IMPORTE'..."
fname = "A7.xml"
Debug.Print "FILE: " & fname
' Output all attributes named "Importe" in a <Traslado> or <Retencion> element.
attributeName = "Importe"
' First look at each <Concepto> in the <Conceptos> element.
' (We can use either "/Comprobante/Conceptos" or "//Conceptos")
xbase = "//Conceptos/Concepto"
i = 1
Do While True
' FOREACH //Conceptos/Concepto[i] element output the value of Importe
xpath = xbase & "[" & i & "]"
s = satGetXmlAttribute(fname, attributeName, xpath)
If Len(s) = 0 Then
Exit Do
End If
Debug.Print xpath & "/@" & attributeName & "='" & s & "'"
' FOREACH //Conceptos/Concepto[i]//Traslado[j] element output the value of Importe
' Long xpath is /Comprobante/Conceptos/Concepto[i]/Impuestos/Traslados/Traslado[j]
j = 1
Do While True
xpath1 = xpath & "//Traslado[" & j & "]"
s = satGetXmlAttribute(fname, attributeName, xpath1)
If Len(s) = 0 Then
Exit Do
End If
Debug.Print xpath1 & "/@" & attributeName & "='" & s & "'"
j = j + 1
Loop
' FOREACH //Conceptos/Concepto[i]//Retencion[j] element output the value of Importe
j = 1
Do While True
xpath1 = xpath & "//Retencion[" & j & "]"
s = satGetXmlAttribute(fname, attributeName, xpath1)
If Len(s) = 0 Then
Exit Do
End If
Debug.Print xpath1 & "/@" & attributeName & "='" & s & "'"
j = j + 1
Loop
i = i + 1
Loop
' Now look in the /Comprobante/Impuestos element.
' NB we cannot use "//Impuestos" here
xpath = "/Comprobante/Impuestos"
' FOREACH /Comprobante/Impuestos//Retencion[j] element output the value of Importe
' Long xpath is /Comprobante/Impuestos/Retenciones/Retencion[j]
j = 1
Do While True
xpath1 = xpath & "//Retencion[" & j & "]"
s = satGetXmlAttribute(fname, attributeName, xpath1)
If Len(s) = 0 Then
Exit Do
End If
Debug.Print xpath1 & "/@" & attributeName & "='" & s & "'"
j = j + 1
Loop
' FOREACH /Comprobante/Impuestos//Traslado[j] element output the value of Importe
j = 1
Do While True
xpath1 = xpath & "//Traslado[" & j & "]"
s = satGetXmlAttribute(fname, attributeName, xpath1)
If Len(s) = 0 Then
Exit Do
End If
Debug.Print xpath1 & "/@" & attributeName & "='" & s & "'"
j = j + 1
Loop
' Improvements in [v9.2]
'
Debug.Print vbLf & "FIND ATTRIBUTES WITH ACCENTED CHARACTERS"
fname = "cfdv33a-nomina12B.xml"
Debug.Print "FILE: " & fname
' Attribute name contains non-ASCII character 'ü', Antigüedad="P3Y2M23D"
elementName = "nomina12:Receptor"
attributeName = "Antigüedad"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
' Attribute name contains non-ASCII character character 'ñ', Año="2016"
elementName = "nomina12:CompensacionSaldosAFavor"
attributeName = "Año"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
' Attribute value contains non-ASCII character 'í', Sindicalizado="Sí"
elementName = "nomina12:Receptor"
attributeName = "Sindicalizado"
s = satGetXmlAttribute(fname, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
Debug.Print vbLf & "READ IN A FILE TO A VBA UNICODE STRING THEN PASS THE STRING AS XML DOC..."
' Use SAT_Asciify to solve the problem of reading UTF-8-encoded file into a VBA String type
Debug.Print "FILE: " & fname & " (" & FileLen(fname) & " bytes)"
xmlstring = satAsciify(fname)
Debug.Print "xmlstring contains " & Len(xmlstring) & " characters"
Debug.Print "Repeat GetXmlAttribute tests above using XML string as input..."
' Attribute name contains non-ASCII character 'ü', Antigüedad="P3Y2M23D"
elementName = "nomina12:Receptor"
attributeName = "Antigüedad"
s = satGetXmlAttribute(xmlstring, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
' Attribute name contains non-ASCII character character 'ñ', Año="2016"
elementName = "nomina12:CompensacionSaldosAFavor"
attributeName = "Año"
s = satGetXmlAttribute(xmlstring, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
' Attribute value contains non-ASCII character 'í', Sindicalizado="Sí"
elementName = "nomina12:Receptor"
attributeName = "Sindicalizado"
s = satGetXmlAttribute(xmlstring, attributeName, elementName)
Debug.Print elementName & "/@" & attributeName & "='" & s & "'"
Debug.Assert (Len(s) > 0)
Debug.Print vbLf & "CHECK XML IS OK USING UNICODE STRING AS INPUT..."
n = SAT_ValidateXml(xmlstring, 0)
Debug.Print "SAT_ValidateXml() returns " & n & " (0 => OK)"
Debug.Assert (0 = n)
Debug.Print vbLf & "FORM MESSAGE DIGEST OF PIPE STRING USING UNICODE STRING AS INPUT..."
dig1 = satMakeDigestFromXml(xmlstring)
Debug.Print "DIGEST(xmlstring)=" & dig1
Debug.Assert (Len(dig1) > 0)
Debug.Print vbLf & "CHECK MESSAGE DIGEST IS THE SAME WHEN USING THE FILE AS INPUT..."
dig2 = satMakeDigestFromXml(fname)
Debug.Print "DIGEST(file)=" & dig2
Debug.Assert (Len(dig1) > 0)
' These should match
Debug.Assert dig1 = dig2
Debug.Print vbLf & "SIGN XML ENTIRELY IN MEMORY..."
' [v9.2] Better to output to a byte array than a string
' i.e. satSignXmlToBytes() is preferred to satSignXmlToString()
keyfile = "emisor.key"
certfile = "emisor.cer"
password = "12345678a"
' Read in key and cert data to strings
keyfiledata = satGetKeyAsPEMString(keyfile, password)
Debug.Assert (Len(keyfiledata) > 0)
certfiledata = satGetCertAsString(certfile)
Debug.Assert (Len(certfiledata) > 0)
' Dim xmlbytes() As Byte
xmlbytes = satSignXmlToBytes(xmlstring, keyfiledata, password, certfiledata, 0)
Debug.Print "Signed XML byte array has " & UBound(xmlbytes) + 1 & " bytes"
Debug.Assert UBound(xmlbytes) >= 0
newname = "frombytes_new.xml"
isok = WriteFileFromBytes(newname, xmlbytes)
Debug.Assert isok
Debug.Print "Created new signed file: " & newname
Debug.Print vbLf & "MAKE SURE WHAT WE CREATED IS OK..."
fname = newname
n = satVerifySignature(fname)
Debug.Print "SAT_VerifySignature(" & fname & ") returns " & n & " (expecting 0)"
Debug.Assert n = 0
Debug.Print "...and we got the same digest value as above..."
dig2 = satExtractDigestFromSignature(fname)
Debug.Print "satExtractDigestFromSignature() returns " & dig2
' Compare digest values (caution upper/lower case)
Debug.Assert StrComp(dig1, dig2, vbTextCompare) = 0
' ********************************************
' FINALLY, SHOW CURRENT VERSION FOR CORE DLL...
Debug.Print vbCrLf & "FirmaSAT Version=" & SAT_Version() & " [" & satCompileTime & "]"
' Change "#If False" to "#If True" to activate this
#If False Then
Debug.Print (vbLf & "DISPLAY ALL POSSIBLE ERROR MESSAGES:");
For i = 0 To 10000
s = satErrorLookup(i)
If Len(s) > 0 Then
Debug.Print i & "=" & s
End If
Next i
#End If
Debug.Print vbCrLf & "ALL DONE."
End Sub
' *********************
' UTILITIES USED HERE *
' *********************
Public Function DispError(nErrCode As Long) As String
' Return string containing error message
Dim strLast As String
If 0 = nErrCode Then
Return
End If
DispError = "Error code " & nErrCode & ": " & satErrorLookup(nErrCode)
strLast = satLastError()
If Len(strLast) > 0 Then
DispError = DispError & ": " & strLast
End If
End Function
Public Function RequiredFilesExist() As Boolean
' Check for required files in current working directory
Dim arrFiles As Variant
Dim vnt As Variant
' Updated [2020-08-05]
arrFiles = Array( _
"A7.xml", "AAA010101AAA201501BN-base.xml", "AAA010101AAA201501CT-base.xml", "AAA010101AAA201705CT.xml", "AC4_SAT.cer", _
"cfdv33a-base.xml", "cfdv33a-base-nocertnum.xml", "cfdv33a-bad-nover.xml", "cfdv33a-cce11-min.xml", "cfdv33a-cce11.xml", _
"cfdv33a-detallista-min.xml", "cfdv33a-detallista.xml", "cfdv33a-min.xml", "cfdv33a-nomina12.xml", "cfdv33a-nomina12B.xml", _
"cfdv33a-pagos10-min.xml", "cfdv33a-pagos10.xml", "cfdv33a-signed-tfd.xml", "cfdv33a-signed.xml", _
"contab-SelloDigitalContElec-signed.xml", "ConVolE12345-base.xml", "ConVolE12345-signed2015.xml", _
"CSD_E12345CV_ACP020530MP5.cer", "CSD_E12345CV_ACP020530MP5.key", _
"Ejemplo_Retenciones-base.xml", "Ejemplo_Retenciones-signed-tfd.xml", _
"ejemplo_v32-tfd2015.xml", "emisor-pem.cer", "emisor-pem.key", "emisor.cer", "emisor.key", _
"emisor1024.cer", "emisor1024.key", "pac.cer", "pac.key", "pac1024.cer", "pac1024.key", _
"V3_2_BadCurp.xml" _
)
For Each vnt In arrFiles
If Not IsNormalFile(CStr(vnt)) Then
Debug.Print "**ERROR: Cannot find file " & vnt
Exit Function
End If
Next
' If we got here, all is OK
RequiredFilesExist = True
End Function
Public Function IsNormalFile(sFileName As String) As Boolean
Dim sDir As String
If Len(sFileName) = 0 Then
IsNormalFile = False
Exit Function
End If
sDir = Dir(sFileName, vbNormal)
IsNormalFile = (Len(sDir) > 0)
End Function
Public Sub Our_Assert(bState As Boolean, Optional strMsg As String)
If bState = False Then
If vbYes = MsgBox("ASSERT ERROR: " & strMsg & vbCrLf & "Stop the program?", vbCritical + vbYesNo, "ASSERT ERROR") Then
Stop
End If
End If
End Sub
Public Function FileHasBOM(sFilePath As String) As Boolean
' Returns true if file has a UTF-8 byte order mark (BOM)
Dim abIn() As Byte
Dim hFile As Integer
' Check if file exists
If Len(Dir(sFilePath)) = 0 Or FileLen(sFilePath) < 3 Then
Exit Function
End If
hFile = FreeFile
Open sFilePath For Binary Access Read As #hFile
abIn = InputB(3, #hFile)
Close #hFile
' BOM consists of three bytes (0xEF, 0xBB, 0xBF)
FileHasBOM = (abIn(0) = &HEF And abIn(1) = &HBB And abIn(2) = &HBF)
End Function
Public Function ReadFileIntoString(sFilePath As String) As String
' Reads file (if it exists) into a string.
Dim strIn As String
Dim hFile As Integer
' Check if file exists
If Len(Dir(sFilePath)) = 0 Then
Exit Function
End If
hFile = FreeFile
Open sFilePath For Binary Access Read As #hFile
strIn = Input(LOF(hFile), #hFile)
Close #hFile
ReadFileIntoString = strIn
End Function
Public Function WriteFileFromString(sFilePath As String, strIn As String) As Boolean
' Creates a file from a string. Clobbers any existing file.
On Error GoTo OnError
Dim hFile As Integer
If Len(Dir(sFilePath)) > 0 Then
Kill sFilePath
End If
hFile = FreeFile
Open sFilePath For Binary Access Write As #hFile
Put #hFile, , strIn
Close #hFile
WriteFileFromString = True
Done:
Exit Function
OnError:
Resume Done
End Function
Public Function WriteFileFromBytes(sFilePath As String, abData() As Byte) As Boolean
' Creates a file from a string. Clobbers any existing file.
On Error GoTo OnError
Dim hFile As Integer
If Len(Dir(sFilePath)) > 0 Then
Kill sFilePath
End If
hFile = FreeFile
Open sFilePath For Binary Access Write As #hFile
Put #hFile, , abData
Close #hFile
WriteFileFromBytes = True
Done:
Exit Function
OnError:
Resume Done
End Function