Attribute VB_Name = "basSc14n"
' $Id: basSc14n.bas $
Option Explicit
Option Base 0

'''
' @file
' @brief The VBA/VB6 interface to the __diSc14n.dll__ library.

' @cond
' Last updated:
' *   $Date: 2019-12-12 21:59 $
' *   $Version: 2.1.0 $

' ------------------------ COPYRIGHT NOTICE ------------------------
' Copyright (c) 2018 DI Management Services Pty Limited.
' <https://di-mgt.com.au> <https://cryptosys.net>. All rights reserved.
' The latest version of SC14N and a licence
' may be obtained from <http://cryptosys.net/sc14n/>.
' Refer to licence for conditions of use.
' This copyright notice must always be left intact.
' ----------------- END OF COPYRIGHT NOTICE ------------------------

' USING WITH A 64-BIT VERSION OF MICROSOFT OFFICE
' -----------------------------------------------
' Edit each declaration statement by adding the keyword "PtrSafe" between
' "Public Declare" and "Function", e.g.
'    Public Declare PtrSafe Function SC14N_Gen_Version Lib "diSc14n.dll" () As Long
' Regex: s/Public Declare Function/Public Declare PtrSafe Function/g
' Do *NOT* change any data types to LongPtr or LongLong.

' @endcond
' @endinternal

''' Use default digest algorithm (SHA-1)
Public Const SC14N_DIG_DEFAULT As Long = 0

''' Use SHA-1 digest algorithm (default)
Public Const SC14N_DIG_SHA1 As Long = 0

''' Use SHA-256 digest algorithm
Public Const SC14N_DIG_SHA256 As Long = &H2000

''' Flatten the XML - remove all ignorable whitespace between tags
Public Const SC14N_OPT_FLATTEN As Long = &H10000

''' Transform the entire document
Public Const SC14N_TRAN_ENTIRE As Long = 0

''' Omit the element with the given tag name
Public Const SC14N_TRAN_OMITBYTAG As Long = &H1

''' Transform the subset with the given tag name
Public Const SC14N_TRAN_SUBSETBYTAG As Long = &H2

''' Omit the element with the given Id
Public Const SC14N_TRAN_OMITBYID As Long = &H11

''' Transform the subset with the given Id
Public Const SC14N_TRAN_SUBSETBYID As Long = &H12

' DEPRECATED FLAGS (use OMIT instead)
''' Omit (exclude) the element with the given tag name
''' @deprecated Use `#SC14N_TRAN_OMITBYTAG`
Public Const SC14N_TRAN_EXCLUDEBYTAG As Long = &H1
''' Omit (exclude) the element with the given Id
''' @deprecated Use `#SC14N_TRAN_OMITBYID`
Public Const SC14N_TRAN_EXCLUDEBYID As Long = &H11

''' Use inclusive c14n method [RFC 3076] (default)
Public Const SC14N_METHOD_INCLUSIVE    As Long = 0
''' Use exclusive c14n method [RFC 3741]
Public Const SC14N_METHOD_EXCLUSIVE    As Long = &H100
''' Include comments in c14n form (@c \#WithComments)
Public Const SC14N_METHOD_WITHCOMMENTS As Long = &H800

''' Maximum number of characters in base64-encoded hash digest value
Public Const SC14N_MAX_DIGEST_CHARS As Long = 44

''' Maximum number of characters in an error message
Public Const SC14N_MAX_ERROR_CHARS As Long = 4073

' GENERAL DIAGNOSTIC FUNCTIONS

''' Gets version number of the core DLL.
'   @return Version number as an integer in the form `major*10000+minor*100+revision`
'   e.g. DLL file version 1.2.x.3 will return 10203
Public Declare Function SC14N_Gen_Version Lib "diSc14n.dll" () As Long

''' Gets licence type.
' @returns ASCII value of the licence type: 'D'=Developer, 'T'=Trial
' @remark Note the Australian/English spelling of "Licence".
Public Declare Function SC14N_Gen_LicenceType Lib "diSc14n.dll" () As Long

''' @cond
' DECLARATIONS OF CORE FUNCTIONS USED INTERNALLY...

' Gets date and time the core DLL module was last compiled. Use sc14nGenCompileTime().
Public Declare Function SC14N_Gen_CompileTime Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long) As Long

' Gets full path name of core DLL module. Use sc14nGenModuleName().
Public Declare Function SC14N_Gen_ModuleName Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long, ByVal nOptions As Long) As Long

' Gets platform on which the core DLL is running ("Win32" or "Win64"). Use sc14nGenPlatform().
Public Declare Function SC14N_Gen_Platform Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long) As Long

' Retrieves the last error message (if available). Use sc14nErrLastError().
Public Declare Function SC14N_Err_LastError Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long) As Long

' Looks up description for error code. Use sc14nErrErrorLookup().
Public Declare Function SC14N_Err_ErrorLookup Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long, ByVal nErrCode As Long) As Long

' Performs C14N transformation of XML document (file-to-file).
Public Declare Function C14N_File2File Lib "diSc14n.dll" (ByVal szOutputFile As String, ByVal szInputFile As String, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Long

' Performs C14N transformation of XML document (file-to-memory).
Public Declare Function C14N_File2String Lib "diSc14n.dll" (ByRef abOut As Byte, ByVal nOutBytes As Long, ByVal szInputFile As String, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Long

' Computes digest value of C14N transformation (file-to-digest).
Public Declare Function C14N_File2Digest Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long, ByVal szInputFile As String, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Long

' Performs C14N transformation of XML document (memory-to-memory).
Public Declare Function C14N_String2String Lib "diSc14n.dll" (ByRef abOut As Byte, ByVal nOutBytes As Long, ByRef lpDataIn As Byte, ByVal nDataLen As Long, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Long

' Computes digest value of C14N transformation (memory-to-digest).
Public Declare Function C14N_String2Digest Lib "diSc14n.dll" (ByVal szOut As String, ByVal nOutChars As Long, ByRef lpDataIn As Byte, ByVal nDataLen As Long, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Long


' WRAPPER FUNCTIONS
''' @endcond

''' Performs C14N transformation of XML document (file-to-file).
' @param szOutputFile Name of output file to create (will be overwritten if exists).
' @param szInputFile Name of input file containing XML document to be processed.
' @param szNameOrId To specify the tag name or Id.
' @param szParams InclusiveNamespaces PrefixList parameter (exclusive C14n only). Use `""` or `vbNullString` to ignore.
' @param nOptions Option flags. Select one of:<br>
' `#SC14N_TRAN_ENTIRE` (0) to transform the entire document (default)<br>
' `#SC14N_TRAN_OMITBYTAG` to exclude the element with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYTAG` to transform subset with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_OMITBYID` to exclude the element with Id specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYID` to transform subset with Id specified in `szNameOrId`<br>
' and optionally add any of:<br>
' `#SC14N_METHOD_EXCLUSIVE` to use exclusive c14n method (default is inclusive c14n method)<br>
' `#SC14N_METHOD_WITHCOMMENTS` to include comments in c14n form (@c \#WithComments)<br>
' @return Zero (0) on success or a @link sc14nErrErrorLookup() nonzero error code @endlink.
Public Function sc14nFile2File(ByVal szOutputFile As String, ByVal szInputFile As String, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Long
    Dim nRet As Long
    nRet = C14N_File2File(szOutputFile, szInputFile, szNameOrId, szParams, nOptions)
    sc14nFile2File = nRet
End Function

''' Performs C14N transformation of XML document (file-to-memory).
' @param szInputFile Name of input file containing XML document to be processed
' @param szNameOrId To specify the tag name or Id.
' @param szParams InclusiveNamespaces PrefixList parameter (exclusive C14n only). Use `""` or `vbNullString` to ignore.
' @param nOptions Option flags. Select one of:<br>
' `#SC14N_TRAN_ENTIRE` (0) to transform the entire document (default)<br>
' `#SC14N_TRAN_OMITBYTAG` to exclude the element with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYTAG` to transform subset with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_OMITBYID` to exclude the element with Id specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYID` to transform subset with Id specified in `szNameOrId`<br>
' and optionally add any of:<br>
' `#SC14N_METHOD_EXCLUSIVE` to use exclusive c14n method (default is inclusive c14n method)<br>
' `#SC14N_METHOD_WITHCOMMENTS` to include comments in c14n form (@c \#WithComments)<br>
' @return UTF-8-encoded byte array _not_ including a terminating zero.
Public Function sc14nFile2Bytes(ByVal szInputFile As String, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    
    sc14nFile2Bytes = vbNullString
    nBytes = C14N_File2String(0, 0, szInputFile, szNameOrId, szParams, nOptions)
    If nBytes <= 0 Then Exit Function
    ReDim abBuffer(nBytes)  ' NB This allocates nBytes+1: we want one extra byte for term'g zero
    nBytes = C14N_File2String(abBuffer(0), nBytes, szInputFile, szNameOrId, szParams, nOptions)
    If nBytes > 0 Then
        ReDim Preserve abBuffer(nBytes - 1) ' Trim term'g zero
        sc14nFile2Bytes = abBuffer
    End If
End Function

''' Computes digest value of C14N transformation (file-to-digest).
' @param szInputFile Name of input file containing XML document to be processed
' @param szNameOrId To specify the tag name or Id.
' @param szParams InclusiveNamespaces PrefixList parameter (exclusive C14n only). Use `""` or `vbNullString` to ignore.
' @param nOptions Option flags. Select one of:<br>
' `#SC14N_TRAN_ENTIRE` (0) to transform the entire document (default)<br>
' `#SC14N_TRAN_OMITBYTAG` to exclude the element with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYTAG` to transform subset with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_OMITBYID` to exclude the element with Id specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYID` to transform subset with Id specified in `szNameOrId`<br>
' and add one of:<br>
' `SC14N_DIG_SHA1` (0) to use SHA-1 algorithm (default) or<br>
' `SC14N_DIG_SHA256` to use SHA-256.<br>
' and optionally add any of:<br>
' `#SC14N_METHOD_EXCLUSIVE` to use exclusive c14n method (default is inclusive c14n method)<br>
' `#SC14N_METHOD_WITHCOMMENTS` to include comments in c14n form (@c \#WithComments)<br>
' @return Digest value as base64-encoded string, or an empty string on error.
Public Function sc14nFile2Digest(ByVal szInputFile As String, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As String
    Dim nc As Long
    Dim strOut As String
    
    nc = C14N_File2Digest(0, 0, szInputFile, szNameOrId, szParams, nOptions)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = C14N_File2Digest(strOut, nc, szInputFile, szNameOrId, szParams, nOptions)
    If nc > 0 Then
        sc14nFile2Digest = strOut
    End If
End Function

''' Performs C14N transformation of XML document (memory-to-memory).
' @param lpDataIn Byte array containing XML data to be processed.
' @param nDataLen Length of input data in bytes.
' @param szNameOrId To specify the tag name or Id.
' @param szParams InclusiveNamespaces PrefixList parameter (exclusive C14n only). Use `""` or `vbNullString` to ignore.
' @param nOptions Option flags. Select one of:<br>
' `#SC14N_TRAN_ENTIRE` (0) to transform the entire document (default)<br>
' `#SC14N_TRAN_OMITBYTAG` to exclude the element with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYTAG` to transform subset with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_OMITBYID` to exclude the element with Id specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYID` to transform subset with Id specified in `szNameOrId`<br>
' and optionally add any of:<br>
' `#SC14N_METHOD_EXCLUSIVE` to use exclusive c14n method (default is inclusive c14n method)<br>
' `#SC14N_METHOD_WITHCOMMENTS` to include comments in c14n form (@c \#WithComments)<br>
' @return UTF-8-encoded byte array _not_ including a terminating zero.
' @remark The output is *always* UTF-8-encoded.
Public Function sc14nBytes2Bytes(lpDataIn() As Byte, ByVal nDataLen As Long, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    
    sc14nBytes2Bytes = vbNullString
    nBytes = C14N_String2String(0, 0, lpDataIn(0), nDataLen, szNameOrId, szParams, nOptions)
    If nBytes <= 0 Then Exit Function
    ReDim abBuffer(nBytes)  ' NB This allocates nBytes+1: we want one extra byte for term'g zero
    nBytes = C14N_String2String(abBuffer(0), nBytes, lpDataIn(0), nDataLen, szNameOrId, szParams, nOptions)
    If nBytes > 0 Then
        ReDim Preserve abBuffer(nBytes - 1) ' Trim term'g zero
        sc14nBytes2Bytes = abBuffer
    End If
End Function

''' Computes digest value of C14N transformation (memory-to-digest).
' @param lpDataIn Byte array containing XML data to be processed.
' @param nDataLen Length of input data in bytes.
' @param szNameOrId To specify the tag name or Id.
' @param szParams InclusiveNamespaces PrefixList parameter (exclusive C14n only). Use `""` or `vbNullString` to ignore.
' @param nOptions Option flags. Select one of:<br>
' `#SC14N_TRAN_ENTIRE` (0) to transform the entire document (default)<br>
' `#SC14N_TRAN_OMITBYTAG` to exclude the element with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYTAG` to transform subset with tag name specified in `szNameOrId`<br>
' `#SC14N_TRAN_OMITBYID` to exclude the element with Id specified in `szNameOrId`<br>
' `#SC14N_TRAN_SUBSETBYID` to transform subset with Id specified in `szNameOrId`<br>
' and add one of:<br>
' `SC14N_DIG_SHA1` (0) to use SHA-1 algorithm (default) or<br>
' `SC14N_DIG_SHA256` to use SHA-256.<br>
' and optionally add any of:<br>
' `#SC14N_METHOD_EXCLUSIVE` to use exclusive c14n method (default is inclusive c14n method)<br>
' `#SC14N_METHOD_WITHCOMMENTS` to include comments in c14n form (@c \#WithComments)<br>
' @return Digest value as base64-encoded string, or an empty string on error.
Public Function sc14nBytes2Digest(lpDataIn() As Byte, ByVal nDataLen As Long, ByVal szNameOrId As String, ByVal szParams As String, ByVal nOptions As Long) As String
    Dim nc As Long
    Dim strOut As String
    
    nc = C14N_String2Digest(0, 0, lpDataIn(0), nDataLen, szNameOrId, szParams, nOptions)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = C14N_String2Digest(strOut, nc, lpDataIn(0), nDataLen, szNameOrId, szParams, nOptions)
    If nc > 0 Then
        sc14nBytes2Digest = strOut
    End If
End Function


''' Gets date and time the core DLL module was last compiled.
' @returns String containing date and time.
Public Function sc14nGenCompileTime() As String
    Dim nc As Long
    Dim strOut As String
    nc = SC14N_Gen_CompileTime("", 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SC14N_Gen_CompileTime(strOut, nc)
    If nc > 0 Then
        sc14nGenCompileTime = strOut
    End If
End Function

''' Gets full path name of core DLL module.
' @returns String containg path name.
Public Function sc14nGenModuleName() As String
    Dim nc As Long
    Dim strOut As String
    nc = SC14N_Gen_ModuleName("", 0, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SC14N_Gen_ModuleName(strOut, nc, 0)
    If nc > 0 Then
        sc14nGenModuleName = strOut
    End If
End Function

''' Gets platform on which the core DLL is running
' @returns String containing `Win32` or `Win64`.
Public Function sc14nGenPlatform() As String
    Dim nc As Long
    Dim strOut As String
    nc = SC14N_Gen_Platform("", 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SC14N_Gen_Platform(strOut, nc)
    If nc > 0 Then
        sc14nGenPlatform = strOut
    End If
End Function

''' Retrieves the last error message (if available).
' @returns String with more information about the last error.
' @remark Not all functions set this.
Public Function sc14nErrLastError() As String
    Dim nc As Long
    Dim strOut As String
    nc = SC14N_Err_LastError("", 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SC14N_Err_LastError(strOut, nc)
    If nc > 0 Then
        sc14nErrLastError = strOut
    End If
End Function

''' Looks up description for error code.
' @param nErrCode Value of error code to lookup (may be positive or negative).
' @returns Description of error code, or empty string if not defined.
Public Function sc14nErrErrorLookup(nErrCode As Long) As String
    Dim nc As Long
    Dim strOut As String
    nc = SC14N_Err_ErrorLookup("", 0, nErrCode)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SC14N_Err_ErrorLookup(strOut, nc, nErrCode)
    If nc > 0 Then
        sc14nErrErrorLookup = strOut
    End If
End Function