Attribute VB_Name = "basMakeEnvio"
' $Id: basMakeEnvio.bas $

' Last updated:
'   $Date: 2021-02-05 00:57Z $
'   $Revision: 1.2.0 $

' /******************************* LICENSE ***********************************
'  * Copyright (C) 2020-21 David Ireland, DI Management Services Pty Limited.
'  * All rights reserved. <https://di-mgt.com.au> <https://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>
' ****************************************************************************

Option Explicit
Option Base 0

Public Const MIN_PKI_VER As Long = 200000
Public Const MIN_SC14N_VER As Long = 20100

' Requires the following applications to be installed:
'   CryptoSys PKI Pro <https://cryptosys.net/pki/>
'   SC14N <https://cryptosys.net/sc14n/>
'   xmlsq <https://cryptosys.net/xmlsq/>

' Requires the following modules to be in the project:
'   basCrPKI.bas v20.0.0
'   basCrPKIWrappers.bas v20.0.2 <https://cryptosys.net/pki/vba-wrappers.html>
'   basSc14n.bas v2.1.0
'   basXmlsq.bas v0.9.0
'   basUtf8FromString.bas <https://di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html>

' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' CAUTION: this code contains a hard-coded date for debugging in `ProcessEnvioDoc`.
' Hardcoded TIMESTAMP is "2020-09-27T18:37:31"
' TODO: remove this hardcoded value and use current time with `Format(Now,...)`
' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

' GLOBAL DEFAULT ALGORITHMS
' These must match the algorithms hard-coded into the Signature template
' (change one, remember to change the other)
Public Const pki_HASHALG As Long = PKI_HASH_SHA1
Public Const pki_SIGALG As Long = PKI_SIG_RSA_SHA1
Public Const sc14n_DIGALG As Long = SC14N_DIG_SHA1
Public Const sc14n_TRANMETHOD As Long = SC14N_METHOD_INCLUSIVE

' Compulsory placeholder expected in documents to be signed.
Public Const SIGPLACE As String = "<Signature>@!SIGNATURE!@</Signature>"


Public Function Main()
    Debug.Print "PKI Version=" & PKI_Version(0, 0)
    Debug.Print "SC14N Version=" & SC14N_Gen_Version()
    Debug.Print "XMLSQ Version=" & XMLSQ_Gen_Version()
    ' Check we have minimum library versions
    Debug.Assert PKI_Version(0, 0) >= MIN_PKI_VER
    Debug.Assert SC14N_Gen_Version() >= MIN_SC14N_VER
    
    ' Expecting `work` subdirectory with working files in it
    ChDir Application.CurrentProject.Path & "\work"
    Debug.Print "CurDir=" & CurDir()
    
    Dim strDigest As String
    strDigest = String(PKI_SHA1_CHARS, " ")
    
    Dim envioDoc As String
    ' Go do the business using test files
    envioDoc = ProcessEnvioDoc("output-enviodte.xml", "user.cer", "user.pfx", "password", _
        "caf33.key", "template-enviodte.xml", "dte-33-1.xml", "dte-33-2.xml")
        
    ' Returns either the name of the file just created or an error message beginning with "**ERROR"
    If InStr(envioDoc, "**ERROR") Then
        Debug.Print envioDoc
    Else
        Debug.Print "Created file [" & envioDoc & "]"
        Call HASH_HexFromFile(strDigest, Len(strDigest), envioDoc, PKI_HASH_SHA1 Or PKI_HASH_MODE_TEXT)
        Debug.Print "HASH(file)=" & strDigest
        Debug.Print
        ' Expected HASH **if** TIMESTAMP is "2020-09-27T18:37:31":
        ' c94db97dbc682c803e2421f42b715c9c840d936c
    End If
    
    ' Go do the business - part 2 - EnvioBOLETA
    envioDoc = ProcessEnvioDoc("output-boleta.xml", "user.cer", "user.pfx", "password", _
        "caf39.key", "template-boleta.xml", "dte-b1.xml", "dte-b2.xml")
    If InStr(envioDoc, "**ERROR") Then
        Debug.Print envioDoc
    Else
        Debug.Print "Created file [" & envioDoc & "]"
        Call HASH_HexFromFile(strDigest, Len(strDigest), envioDoc, PKI_HASH_SHA1 Or PKI_HASH_MODE_TEXT)
        Debug.Print "HASH(file)=" & strDigest
        Debug.Print
        ' Expected HASH **if** TIMESTAMP is "2020-09-27T18:37:31":
        ' b6f76d84ca854d163643e6efe9bfc0a970f2f20b
    End If

End Function


''' <summary>
''' Create signed Envio document.
''' </summary>
''' <param name="outputxmlFile">Name of output file to create.</param>
''' <param name="certFile">Signer's X.509 certificate file (.cer).</param>
''' <param name="keyFile">Signer's private key file (.pfx)</param>
''' <param name="password">Password for private key file.</param>
''' <param name="cafKeyFile">CAF private key file.</param>
''' <param name="outerTemplate">XML template for outer Envio document.</param>
''' <param name="dtedocs">List of DTE XML documents to be signed (comma-separated list of filenames)</param>
''' <returns>Name of output file created if successful, or an error message that begins with "**ERROR:"</returns>
Public Function ProcessEnvioDoc(strOutputXmlFile As String, strCertFile As String, strKeyFile As String, strPassword As String, _
    strCafKeyFile As String, strOuterTemplate As String, ParamArray arrDteDocNames() As Variant) As String
    Dim colDteList As New Collection
    Dim i As Integer
    Dim n As Long
    Dim nChars As Long
    Dim nBytes As Long
    Dim strMsg As String
    Dim xmlsetdte As String
    Dim strSigningTime As String
    Dim strCertStr As String
    Dim strCafKey As String
    Dim strPriKey As String
    Dim strPubKey As String
    Dim strDteDoc As String
    Dim docid As String
    Dim sig As String
    Dim xmlData() As Byte
    Dim toinsert As String
    
    ' Compulsory placeholder expected in outer template.
    Const SETOFDTEPLACE As String = "<DTE>@!SET-OF-DTE!@</DTE>"
    
    ' Read in outer template
    xmlsetdte = ReadFileIntoString(strOuterTemplate)
    If Len(xmlsetdte) = 0 Then
        strMsg = "**ERROR: Failed to read template file '" & strOuterTemplate & "'"
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    
    ' Check for required placeholders
    If InStr(xmlsetdte, SIGPLACE) = 0 Then
        strMsg = "**ERROR: Placeholder is missing: " & SIGPLACE
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    If InStr(xmlsetdte, SETOFDTEPLACE) = 0 Then
        strMsg = "**ERROR: Placeholder is missing: " & SETOFDTEPLACE
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    
    ' Read in certificate file to a one-line base64 string
    strCertStr = x509ReadStringFromFile(strCertFile, 0)
    If Len(strCertStr) = 0 Then
        strMsg = "**ERROR: Failed to read X.509 certificate in '" & strCertFile & "'"
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    
    ' Read in CAF private key (no password)
    strCafKey = rsaReadPrivateKey(strCafKeyFile, "")
    If Len(strCafKey) = 0 Then
        strMsg = "**ERROR: Failed to read CAF private key in '" & strCafKeyFile & "'"
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    Debug.Print "CAF key has " & RSA_KeyBits(strCafKey) & " bits"
    
    ' Read in private key from PFX file
    strPriKey = rsaReadPrivateKey(strKeyFile, strPassword)
    If Len(strPriKey) = 0 Then
        strMsg = "**ERROR: Failed to read private key in '" & strKeyFile & "'"
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    Debug.Print "Private key has " & RSA_KeyBits(strPriKey) & " bits"
    
    ' Check private key matches certificate
    strPubKey = rsaReadPublicKey(strCertStr)
    n = RSA_KeyMatch(strPriKey, strPubKey)
    If (n <> 0) Then
        strMsg = "**ERROR: private key and certificate do not match."
        Debug.Print strMsg
        ProcessEnvioDoc = strMsg
        Exit Function
    End If
    
    ' Set signing time in <xs:datetime> form
    strSigningTime = Format(Now, "yyyy-mm-ddThh:mm:ss")
    ' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ' CAUTION: hard-coded value here for debugging
    ' TODO: [DEBUG] remove this line
    strSigningTime = "2020-09-27T18:37:31"
    ' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    Debug.Print "signingTime=" & strSigningTime

    ' Iterate through list of DTE documents
    For i = 0 To UBound(arrDteDocNames)
        strDteDoc = ProcessDte(CStr(arrDteDocNames(i)), strCertStr, strPriKey, strCafKey, strSigningTime)
        ' Catch error - result contains "**ERROR"
        If InStr(strDteDoc, "**ERROR") > 0 Then
            strMsg = strDteDoc
            Debug.Print strMsg
            ProcessEnvioDoc = strMsg
            Exit Function
        End If
        'Debug.Print strDteDoc
        ' Store signed DTE document to be used later.
        colDteList.Add strDteDoc
    Next
    
    ' Process remainder of outer document
    Debug.Print vbCrLf & "Processing outer document..."
    xmlsetdte = Replace(xmlsetdte, "@!TIMESTAMP!@", strSigningTime)
    n = colDteList.Count
    xmlsetdte = Replace(xmlsetdte, "@!NUM-DTE!@", n)
    
    
    ' Concatenate the collection of signed DTE docs into an array
    toinsert = Join(CollectionToArray(colDteList), vbCrLf)
    ' Insert DTE docs into Envio outer XML
    xmlsetdte = Replace(xmlsetdte, "<DTE>@!SET-OF-DTE!@</DTE>", toinsert)

    
    ' Extract ID of SetDTE for Signature reference
    docid = xmlsqGetText(xmlsetdte, "//SetDTE/@ID", 0)
    Debug.Print "SetDTE ID=" & docid

    ' Convert XML string to bytes: NB explicit Latin-1 encoding.
    xmlData = StrConv(xmlsetdte, vbFromUnicode)
    
    ' Compute the signature over the element SetDTE
    sig = MakeSignature(xmlData, docid, "SetDTE", strPriKey, strCertStr)
    Debug.Assert Len(sig) > 0
    xmlsetdte = Replace(xmlsetdte, SIGPLACE, sig)
    
    ' Final check for uncompleted '@!..!@'
    If InStr(xmlsetdte, "@!") > 0 Then
        Debug.Print "WARNING: uncompleted '@!..!@' items"
    End If
    
    ' Write out the final output file in Latin-1
    xmlData = StrConv(xmlsetdte, vbFromUnicode)
    Call WriteFileFromBytes(strOutputXmlFile, xmlData)
    
    ' Clean up private keys
    strCafKey = wipeString(strCafKey)
    strPriKey = wipeString(strPriKey)
    
    
    ProcessEnvioDoc = strOutputXmlFile
    
End Function


''' <summary>
''' Process an individual DTE document.
''' </summary>
''' <param name="xmlFile">Base DTE file to be processed with placeholders of form "@!...!@".</param>
''' <param name="certStr">User's X.509 certificate as a base64 string.</param>
''' <param name="sbPriKey">User's private signing key in Pki internal string form.</param>
''' <param name="sbCafKey">User's CAF private key in Pki internal string form.</param>
''' <param name="signingtime">Signing time as string in xs:dateTime form.</param>
''' <returns>Signed DTE document as a string, or an error message that begins with "**ERROR:"</returns>
Public Function ProcessDte(strXmlFile As String, strCertStr As String, strPriKey As String, strCafKey As String, strSigningTime As String) As String
    Dim xmlData() As Byte
    Dim b() As Byte
    Dim dig() As Byte
    Dim xmlStr As String
    Dim strMsg As String
    Dim fecha As String
    Dim ddelem As String
    Dim frmtSig As String
    Dim docid As String
    Dim sig As String
    Dim n As Long
    Dim nBytes As Long
    Dim nChars As Long
    Dim xmlnewfile As String
    Dim header As String
    Dim temps As String
    Dim regex As Object
    Dim matches As Object
    
    ' Compulsory placeholder expected in DTE base document.
    Const FRMTSIGPLACE As String = "@!FRMT-SIG!@"
    
    ' NOTE: we use standard Unicode strings for string manipulation and regex,
    ' and byte arrays for crypto and C14N operations.
    
    Debug.Print vbCrLf & "Processing file: " & strXmlFile
    
    ' Read in the base XML file as bytes
    xmlData = ReadFileIntoBytes(strXmlFile)
    If cnvBytesLen(xmlData) = 0 Then
        strMsg = "**ERROR: Failed to read XML file '" & strXmlFile & "'"
        Debug.Print strMsg
        ProcessDte = strMsg
        Exit Function
    End If
    
    ' Convert XML byte input to a Unicode string for regex/replace editing
    ' Try to guess encoding: expecting either Latin-1 or UTF-8 (or just plain US-ASCII, a subset of UTF-8)
    n = CNV_CheckUTF8Bytes(xmlData(0), cnvBytesLen(xmlData))
    If 0 = n Then
        ' Not valid UTF-8, so probably Latin-1
        xmlStr = StrConv(xmlData, vbUnicode)
    Else
        xmlStr = Utf8BytesToString(xmlData)
    End If
    
    ' Check for required placeholders
    If InStr(xmlStr, SIGPLACE) = 0 Then
        strMsg = "**ERROR: Placeholder is missing"
        Debug.Print strMsg
        ProcessDte = strMsg
        Exit Function
    End If
    If InStr(xmlStr, FRMTSIGPLACE) = 0 Then
        strMsg = "**ERROR: Placeholder is missing"
        Debug.Print strMsg
        ProcessDte = strMsg
        Exit Function
    End If
    
    ' Set signing time in document placeholder
    xmlStr = Replace(xmlStr, "@!TIMESTAMP!@", strSigningTime)
    ' And set the Fecha Emision Contable del DTE (AAAA-MM-DD)
    fecha = Left(strSigningTime, 10)
    xmlStr = Replace(xmlStr, "@!FECHA!@", fecha)
    
    'Debug.Print xmlStr

    ' [2021-02-05] FIX
    ' We can use Xmlsq to extract the flattened DD element - NO!
    ' PROBLEM: Xpath converts XML entities &apos; and &qout; to literal characters, e.g. " and '
    ' ddelem = xmlsqFullQuery(xmlStr, "//DD", XMLSQ_RAW Or XMLSQ_TRIM)
    ' SOLUTION: Use regex instead to extract the <DD> element.
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = "(<DD[\s\S]*</DD>)"
        .Multiline = True
    End With
    If regex.Test(xmlStr) Then
        ' (May need error handling here...)
        Set matches = regex.Execute(xmlStr)
        ddelem = matches(0).SubMatches(0)
    Else
        strMsg = "**ERROR: Cannot find DD element in DTE document"
        Debug.Print strMsg
        ProcessDte = strMsg
        Exit Function
    End If
    ' Now flatten it - this is the input for the FRMT signature
    With regex
        .Pattern = ">\s+<"
        .Global = True
    End With
    ddelem = regex.Replace(ddelem, "><")
    
    Debug.Print "---" & vbCrLf & ddelem & vbCrLf & "---"
    
    ' Convert to bytes in Latin-1 encoding
    b = StrConv(ddelem, vbFromUnicode)
    
    ' Compute FRMT signature over the flattened, Latin-1-encoded <DD> element using CAF key
    frmtSig = sigSignData(b, strCafKey, "", "", pki_SIGALG)
    Debug.Print "SIG(<DD>)=" & frmtSig
    Debug.Assert Len(frmtSig) > 0
    
    ' Insert this signature in placeholder @!FRMT-SIG!@
    xmlStr = Replace(xmlStr, "@!FRMT-SIG!@", frmtSig)
    
    ' Copy updated XML string to array of bytes, this time in UTF-8 encoding
    xmlData = Utf8BytesFromString(xmlStr)
    nBytes = cnvBytesLen(xmlData)
    
    ' Do a test C14N calc on this data to see if any XML problems
    dig = sc14nBytes2Digest(xmlData, nBytes, "", "", 0)
    If cnvBytesLen(dig) = 0 Then
        strMsg = "**ERROR: XML problem: " & sc14nErrLastError()
        Debug.Print strMsg
        ProcessDte = strMsg
        Exit Function
    End If
    
    ' Extract ID of Documento for Signature reference
    docid = xmlsqGetText(xmlStr, "//Documento/@ID", 0)
    Debug.Print "Documento ID=" & docid
    
    ' Compute the signature over the element <Documento>
    sig = MakeSignature(xmlData, docid, "Documento", strPriKey, strCertStr)
    'Debug.Print "---" & vbCrLf & sig & vbCrLf & "---"
    
    ' Insert the completed Signature into the parent DTE document
    xmlStr = Replace(xmlStr, SIGPLACE, sig)
    
    ' Final check for uncompleted '@!..!@'
    If InStr(xmlStr, "@!") > 0 Then
        Debug.Print "WARNING: uncompleted '@!..!@' items"
    End If
    
    ' Output XML should now be complete
    ' Convert to UTF-8 bytes for XML check
    xmlData = Utf8BytesFromString(xmlStr)
    nBytes = cnvBytesLen(xmlData)
    ' Final check
    dig = sc14nBytes2Digest(xmlData, nBytes, "", "", 0)
    If cnvBytesLen(dig) = 0 Then
        strMsg = "**ERROR: XML problem: " & sc14nErrLastError()
        Debug.Print strMsg
        ProcessDte = strMsg
        Exit Function
    End If
    
    ' Save this DTE doc as a file for checking.
    xmlnewfile = AppendToFileStem(strXmlFile, "-signed")
    
    ' Add header to XML document and save
    header = "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbCrLf & _
        "<!DOCTYPE DTE [" & vbCrLf & _
        "<!ATTLIST Documento ID ID #IMPLIED>" & vbCrLf & _
        "]>"
    temps = header & vbCrLf & xmlStr
    WriteFileFromString xmlnewfile, temps
    Debug.Print "Saved temp DTE file '" & xmlnewfile & "'"
    
    
    ' Return the XML doc as a string (without the extra DOCTYPE header)
    ProcessDte = xmlStr
    
End Function


''' <summary>
''' Create the Signature element to be inserted in <c><Signature>@!SIGNATURE!@</Signature></c>placeholder.
''' </summary>
''' <param name="xmldata">XML data in byte array including element-to-be-signed</param>
''' <param name="docid">ID of element to be signed</param>
''' <param name="elemName">Name of element to be signed</param>
''' <param name="sbPriKey">RSA private signing key as internal string</param>
''' <param name="certStr">User's signing certificate as a base64 string</param>
''' <returns>String containing the completed Signature element</returns>
''' <remarks>Example element-to-be-signed: <c>Documento ID="Ejemplo_F101T39"</c>
''' => <c>Reference URI="#Ejemplo_F101T39"</c>
''' </remarks>
Public Function MakeSignature(xmlData() As Byte, docid As String, elemName As String, priKeyStr As String, certStr As String) As String
    Dim nDataLen As Long
    Dim nChars As Long
    Dim sig As String
    Dim digval As String
    Dim sigval As String
    Dim doc As String
    Dim nsigs As Long
    Dim siref As String
    Dim b() As Byte
    Dim lpDig() As Byte
    Dim xs As String
    
    ' Get Signature template
    sig = SignatureTemplate()
    
    ' 1. Insert all required values in the SignedInfo element
    
    ' 1.1 Insert docid in the Signature element @!DOCID!@
    sig = Replace(sig, "@!DOCID!@", docid)
    
    ' Compute digest value for C14N of element-to-be-signed
    nDataLen = cnvBytesLen(xmlData)
    digval = sc14nBytes2Digest(xmlData, nDataLen, elemName, "", SC14N_TRAN_SUBSETBYTAG Or sc14n_DIGALG Or sc14n_TRANMETHOD)
    Debug.Print "DigestValue=" & digval
    Debug.Assert Len(digval) > 0
    
    ' 1.2 Insert DigestValue in the Signature element @!DIGVAL!@
    sig = Replace(sig, "@!DIGVAL!@", digval)
    
    ' Compute digest of SignedInfo
    ' Need to include entire document with all parent namespaces to propagate down to SignedInfo
    ' Make a temp string of entire document so we can insert the partially-made Signature element into it
    doc = Utf8BytesToString(xmlData)
    doc = Replace(doc, SIGPLACE, sig)
    ' Count number of Signature elements in doc - we want the last one
    nsigs = xmlsqCount(doc, "//Signature", 0)
    Debug.Assert nsigs > 0
    siref = "SignedInfo[" & nsigs & "]"
    Debug.Print "siref=" & siref
    ' Now back to a temp byte array to perform C14N on SignedInfo
    b = Utf8BytesFromString(doc)
    digval = sc14nBytes2Digest(b, cnvBytesLen(b), siref, "", SC14N_TRAN_SUBSETBYTAG Or sc14n_DIGALG Or sc14n_TRANMETHOD)
    Debug.Print "Digest(" & siref & ")=" & digval
    Debug.Assert Len(digval) > 0
    
    ' Compute signature value using digest of data
    lpDig = cnvBytesFromB64Str(digval)
    sigval = sigSignData(lpDig, priKeyStr, "", "", pki_SIGALG Or PKI_SIG_USEDIGEST)
    Debug.Print "Signature=" & sigval
    Debug.Assert Len(sigval) > 0
    ' Insert in Signature string
    sig = Replace(sig, "@!SIGVAL!@", vbCrLf & Wrap(sigval) & vbCrLf)
    
    ' Insert all remaining values into the Signature string
    ' (NB these do not affect the SignatureValue)

    ' Extract and substitute RSAKeyValue components
    xs = rsaKeyValue(priKeyStr, "Modulus", 0)
    sig = Replace(sig, "@!RSA-MOD!@", vbCrLf & Wrap(xs) & vbCrLf)
    xs = rsaKeyValue(priKeyStr, "Exponent", 0)
    sig = Replace(sig, "@!RSA-EXP!@", xs)
    
    ' Insert the cert string after line wrapping
    xs = vbCrLf & Wrap(certStr) & vbCrLf
    sig = Replace(sig, "@!CERTIFICATE!@", xs)
    

    ' Return the Signature string
    MakeSignature = sig
    
End Function


'''  <summary>
'''  Template for Signature element.
'''  </summary>
'''  <returns>Signature template string.</returns>
'''  <remarks>Hard-coded algorithms here must match global default algorithms.</remarks>
Public Function SignatureTemplate() As String
    Dim s As String

    s = "<Signature xmlns=""http://www.w3.org/2000/09/xmldsig#"">" & vbCrLf & _
        "<SignedInfo>" & vbCrLf & _
        "<CanonicalizationMethod Algorithm=""http://www.w3.org/TR/2001/REC-xml-c14n-20010315""/>" & vbCrLf & _
        "<SignatureMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#rsa-sha1""/>" & vbCrLf & _
        "<Reference URI=""#@!DOCID!@"">" & vbCrLf & _
        "<Transforms>" & vbCrLf & _
        "<Transform Algorithm=""http://www.w3.org/TR/2001/REC-xml-c14n-20010315""/>" & vbCrLf & _
        "</Transforms>" & vbCrLf & _
        "<DigestMethod Algorithm=""http://www.w3.org/2000/09/xmldsig#sha1""/>" & vbCrLf & _
        "<DigestValue>@!DIGVAL!@</DigestValue>" & vbCrLf & _
        "</Reference>" & vbCrLf & _
        "</SignedInfo>" & vbCrLf & _
        "<SignatureValue>@!SIGVAL!@</SignatureValue>" & vbCrLf & _
        "<KeyInfo>" & vbCrLf & _
        "<KeyValue>" & vbCrLf & _
        "<RSAKeyValue>" & vbCrLf & _
        "<Modulus>@!RSA-MOD!@</Modulus>" & vbCrLf & _
        "<Exponent>@!RSA-EXP!@</Exponent>" & vbCrLf & _
        "</RSAKeyValue>" & vbCrLf & _
        "</KeyValue>" & vbCrLf & _
        "<X509Data>" & vbCrLf & _
        "<X509Certificate>@!CERTIFICATE!@</X509Certificate>" & vbCrLf & _
        "</X509Data>" & vbCrLf & _
        "</KeyInfo>" & vbCrLf & _
        "</Signature>"
    SignatureTemplate = s

End Function


' *********
' UTILITIES
' *********

''' Wrap a long single-line string at 64 columns
Public Function Wrap(singleLineString As String) As String
    Const columns As Long = 64
    Dim rows As Long
    Dim i As Long
    Dim index As Long
    Dim s As String
    Dim ss As String
    
    rows = (Len(singleLineString) + columns - 1) \ columns
    If rows < 2 Then
        Wrap = singleLineString
        Exit Function
    End If
    s = ""
    For i = 0 To rows - 1
        index = i * columns + 1     ' one-indexed
        ss = Mid$(singleLineString, index, columns)
        If i > 0 Then
            s = s & vbCrLf & ss
        Else
            s = s & ss
        End If
    Next
    Wrap = s
End Function


''' Append a string to file stem inside a file name/path.
''' @param strFileName File name/path to be changed, e.g. "C:\dir\subdir\filename.ext" or "filename.ext"
''' @param strAppendage String to append to file stem, e.g. "-appendme"
''' @returns New file name with appendage, e.g. "C:\dir\subdir\filename-appendme.ext"
''' @remark Always returns a full absolute path.
Public Function AppendToFileStem(strFileName As String, strAppendage As String) As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim filefullpath As String
    Dim filestem As String
    Dim dirname As String
    Dim extn As String
    Dim newfilename As String
    
    filefullpath = fso.GetAbsolutePathName(strFileName)
    'Debug.Print filefullpath
    filestem = fso.GetBaseName(filefullpath)
    'Debug.Print filestem
    extn = fso.GetExtensionName(filefullpath)
    'Debug.Print extn
    dirname = fso.GetParentFolderName(filefullpath)
    'Debug.Print dirname
    newfilename = fso.BuildPath(dirname, filestem + strAppendage + "." & extn)
    'Debug.Print newfilename
    
    AppendToFileStem = newfilename
End Function

Public Function CollectionToArray(myCol As Collection) As Variant
' Acknowledgments to Vityata
' Ref: https://stackoverflow.com/questions/29015444/how-to-join-a-collection-in-vba
    Dim result  As Variant
    Dim cnt     As Long
    ReDim result(myCol.Count - 1)
    For cnt = 0 To myCol.Count - 1
        result(cnt) = myCol(cnt + 1)
    Next cnt
    CollectionToArray = result
End Function


' **************
' FILE UTILITIES
' **************

Private 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

Private Function ReadFileIntoBytes(sFilePath As String) As Byte()
' Reads file (if it exists) into a byte array.
    Dim abIn() As Byte
    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
    abIn = InputB(LOF(hFile), #hFile)
    Close #hFile
    ReadFileIntoBytes = abIn
    
End Function

Private 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

Private 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