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

' This module contains the full list of declaration statements
' for FirmaSAT VB6/VBA version.
' Last updated:
' *   $Date: 2020-08-05 23:31 $
' *   $Version: 9.2.0 $

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


Option Explicit
Option Base 0

' OPTIONS FLAGS
Public Const SAT_GEN_PLATFORM      As Long = &H40
Public Const SAT_HASH_DEFAULT      As Long = 0        ' Use appropriate default digest algorithm
Public Const SAT_HASH_SHA1         As Long = &H20     ' Force SHA-1 algorithm [debugging only]
Public Const SAT_HASH_SHA256       As Long = &H30     ' Force SHA-256 algorithm [debugging only]
Public Const SAT_DATE_NOTBEFORE    As Long = &H1000
Public Const SAT_TFD               As Long = &H8000&
Public Const SAT_XML_LOOSE         As Long = &H4000
Public Const SAT_XML_STRICT        As Long = 0
Public Const SAT_ENCODE_UTF8       As Long = 0
Public Const SAT_ENCODE_LATIN1     As Long = 1
Public Const SAT_FILE_NO_BOM       As Long = &H2000
Public Const SAT_FILE_BIGFILE      As Long = &H8000000
Public Const SAT_KEY_ENCRYPTED     As Long = &H10000
Public Const SAT_XML_EMPTYELEMTAG  As Long = &H20000
Public Const SAT_GEN_DIGALG        As Long = &H2000     ' New in [v8.1]
Public Const SAT_FORMAT_PEM        As Long = &H10000    ' New in [v8.2]

' CONSTANTS
Public Const SAT_MAX_HASH_CHARS    As Long = 40
Public Const SAT_MAX_ERROR_CHARS   As Long = 4073

' ENUMERATION
Public Enum HashAlgorithm
    hashDefault = SAT_HASH_DEFAULT
    hashSHA1 = SAT_HASH_SHA1        ' [debugging purposes only]
    hashSHA256 = SAT_HASH_SHA256    ' [debugging purposes only]
End Enum

' DIAGNOSTIC FUNCTIONS
Public Declare Function SAT_Version Lib "diFirmaSAT2.dll" () As Long
Public Declare Function SAT_CompileTime Lib "diFirmaSAT2.dll" (ByVal strOutput As String, ByVal nOutChars As Long) As Long
Public Declare Function SAT_ModuleName Lib "diFirmaSAT2.dll" (ByVal strOutput As String, ByVal nOutChars As Long, ByVal reserved As Long) As Long
Public Declare Function SAT_LicenceType Lib "diFirmaSAT2.dll" () As Long
Public Declare Function SAT_Comments Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal nOptions As Long) As Long

' ERROR-RELATED FUNCTIONS
Public Declare Function SAT_LastError Lib "diFirmaSAT2.dll" (ByVal strErrMsg As String, ByVal nMsgLen As Long) As Long
Public Declare Function SAT_ErrorLookup Lib "diFirmaSAT2.dll" (ByVal strErrMsg As String, ByVal nMsgLen As Long, ByVal nErrCode As Long) As Long

' SAT XML FUNCTIONS
Public Declare Function SAT_MakePipeStringFromXml Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_MakeSignatureFromXml Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal strKeyFile As String, ByVal strPassword As String) As Long
Public Declare Function SAT_MakeSignatureFromXmlEx Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal strKeyFile As String, ByVal strPassword As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_ValidateXml Lib "diFirmaSAT2.dll" (ByVal strXmlFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_VerifySignature Lib "diFirmaSAT2.dll" (ByVal strXmlFile As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_SignXml Lib "diFirmaSAT2.dll" (ByVal strOutputFile As String, ByVal strInputXmlFile As String, ByVal strKeyFile As String, ByVal strPassword As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_GetXmlAttribute Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal strAttribute As String, ByVal strElement As String) As Long
Public Declare Function SAT_GetXmlAttributeEx Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal strAttribute As String, ByVal strElement As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_MakeDigestFromXml Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_ExtractDigestFromSignature Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_GetCertNumber Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strFileName As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_GetCertExpiry Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strFileName As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_GetCertAsString Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strFileName As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_CheckKeyAndCert Lib "diFirmaSAT2.dll" (ByVal strKeyFile As String, ByVal strPassword As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_XmlReceiptVersion Lib "diFirmaSAT2.dll" (ByVal strXmlFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_FixBOM Lib "diFirmaSAT2.dll" (ByVal strOutputFile As String, ByVal strInputFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_GetKeyAsString Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strKeyFile As String, ByVal strPassword As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_WritePfxFile Lib "diFirmaSAT2.dll" (ByVal strOutputFile As String, ByVal strPfxPassword As String, ByVal strKeyFile As String, ByVal strKeyPassword As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_QueryCert Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strFileName As String, ByVal strQuery As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_Uuid Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal nOptions As Long) As Long
Public Declare Function SAT_Asciify Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_InsertCert Lib "diFirmaSAT2.dll" (ByVal strOutputFile As String, ByVal strXmlFile As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_InsertCertToString Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlData As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_NewKeyFile Lib "diFirmaSAT2.dll" (ByVal strOutputFile As String, ByVal strNewPassword As String, ByVal strKeyFile As String, ByVal strPassword As String, ByVal strReserved As String, ByVal nOptions As Long) As Long
Public Declare Function SAT_SignXmlToString Lib "diFirmaSAT2.dll" (ByVal strOut As String, ByVal nOutChars As Long, ByVal strXmlData As String, ByVal strKeyFile As String, ByVal strPassword As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long
' Alias for VB6
Public Declare Function SAT_SignXmlToBytes Lib "diFirmaSAT2.dll" Alias "SAT_SignXmlToString" (ByRef lpOut As Byte, ByVal nOutBytes As Long, ByVal strXmlData As String, ByVal strKeyFile As String, ByVal strPassword As String, ByVal strCertFile As String, ByVal nOptions As Long) As Long


' *** END OF FIRMASAT DECLARATIONS

' *****************
' WRAPPER FUNCTIONS
' *****************
' Direct calls to the DLL begin with "SAT_", wrapper functions begin with "sat"
' We choose to provide these wrappers as functions rather than class methods.
' It is a simple matter to convert these wrapper functions into a class should you so desire.

Public Function satModuleName() As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_ModuleName("", 0, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_ModuleName(strOut, nc, 0)
    If nc > 0 Then
        satModuleName = strOut
    End If
End Function

Public Function satPlatform() As String
' NB This will *always* return "Win32" (because VB6 is only 32-bit)
    Dim nc As Long
    Dim strOut As String
    nc = SAT_ModuleName("", 0, SAT_GEN_PLATFORM)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_ModuleName(strOut, nc, SAT_GEN_PLATFORM)
    If nc > 0 Then
        satPlatform = strOut
    End If
End Function

Public Function satCompileTime() As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_CompileTime("", 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_CompileTime(strOut, nc)
    If nc > 0 Then
        satCompileTime = strOut
    End If
End Function

Public Function satComments() As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_Comments("", 0, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_Comments(strOut, nc, 0)
    If nc > 0 Then
        satComments = strOut
    End If
End Function

Public Function satLastError() As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_LastError("", 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_LastError(strOut, nc)
    If nc > 0 Then
        satLastError = strOut
    End If
End Function

Public Function satErrorLookup(nErrCode As Long) As String
    Dim nc As Long
    Dim strOut As String
    strOut = String(255, " ")
    nc = SAT_ErrorLookup(strOut, Len(strOut), nErrCode)
    If nc > 0 Then
        satErrorLookup = Trim(strOut)
    End If
End Function

Public Function satMakePipeStringFromXml(strXmlFile As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_MakePipeStringFromXml("", 0, strXmlFile, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_MakePipeStringFromXml(strOut, nc, strXmlFile, 0)
    If nc > 0 Then
        satMakePipeStringFromXml = Trim(strOut)
    End If
End Function

Public Function satMakeDigestFromXml(strXmlFile As String, Optional HashAlg As HashAlgorithm = 0) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_MakeDigestFromXml("", 0, strXmlFile, HashAlg)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_MakeDigestFromXml(strOut, nc, strXmlFile, HashAlg)
    If nc > 0 Then
        satMakeDigestFromXml = strOut
    End If
End Function

Public Function satExtractDigestFromSignature(strXmlFile As String, Optional strCertFile As String = vbNullString) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_ExtractDigestFromSignature("", 0, strXmlFile, strCertFile, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_ExtractDigestFromSignature(strOut, nc, strXmlFile, strCertFile, 0)
    If nc > 0 Then
        satExtractDigestFromSignature = strOut
    End If
End Function

Public Function satVerifySignature(strXmlFile As String, Optional strCertFile As String = vbNullString) As Long
    satVerifySignature = SAT_VerifySignature(strXmlFile, strCertFile, 0)
End Function

Public Function satMakeSignatureFromXml(strXmlFile As String, strKeyFile As String, strPassword As String, Optional HashAlg As HashAlgorithm = 0) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_MakeSignatureFromXmlEx("", 0, strXmlFile, strKeyFile, strPassword, HashAlg)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_MakeSignatureFromXmlEx(strOut, nc, strXmlFile, strKeyFile, strPassword, HashAlg)
    If nc > 0 Then
        satMakeSignatureFromXml = strOut
    End If
End Function

Public Function satGetXmlAttribute(strXmlFile As String, strAttributeName As String, strElementName As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetXmlAttributeEx("", 0, strXmlFile, strAttributeName, strElementName, SAT_ENCODE_LATIN1)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetXmlAttributeEx(strOut, nc, strXmlFile, strAttributeName, strElementName, SAT_ENCODE_LATIN1)
    If nc > 0 Then
        satGetXmlAttribute = Left$(strOut, nc)
    End If
End Function

Public Function satGetCertNumber(strFileName As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetCertNumber("", 0, strFileName, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetCertNumber(strOut, nc, strFileName, 0)
    If nc > 0 Then
        satGetCertNumber = strOut
    End If
End Function

Public Function satGetCertExpiry(strFileName As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetCertExpiry("", 0, strFileName, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetCertExpiry(strOut, nc, strFileName, 0)
    If nc > 0 Then
        satGetCertExpiry = strOut
    End If
End Function

Public Function satGetCertStart(strFileName As String) As String
' [v3.0] Added option to get certificate start date
' Deprecated as of [v5.1] - use satQueryCert
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetCertExpiry("", 0, strFileName, SAT_DATE_NOTBEFORE)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetCertExpiry(strOut, nc, strFileName, SAT_DATE_NOTBEFORE)
    If nc > 0 Then
        satGetCertStart = strOut
    End If
End Function

Public Function satGetCertAsString(strFileName As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetCertAsString("", 0, strFileName, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetCertAsString(strOut, nc, strFileName, 0)
    If nc > 0 Then
        satGetCertAsString = strOut
    End If
End Function

Public Function satGetKeyAsString(strFileName As String, strPassword As String) As String
' Returns unencrypted key as a plain base64 string
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetKeyAsString("", 0, strFileName, strPassword, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetKeyAsString(strOut, nc, strFileName, strPassword, 0)
    If nc > 0 Then
        satGetKeyAsString = strOut
    End If
End Function

Public Function satGetKeyAsPEMString(strFileName As String, strPassword As String) As String
' Returns encrypted private key as PEM string
    Dim nc As Long
    Dim strOut As String
    nc = SAT_GetKeyAsString("", 0, strFileName, strPassword, SAT_KEY_ENCRYPTED)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_GetKeyAsString(strOut, nc, strFileName, strPassword, SAT_KEY_ENCRYPTED)
    If nc > 0 Then
        satGetKeyAsPEMString = strOut
    End If
End Function

Public Function satQueryCert(strFileName As String, strQuery As String) As String
    Dim nc As Long
    Dim strOut As String
    ' NB force Latin-1 for output here
    nc = SAT_QueryCert("", 0, strFileName, strQuery, SAT_ENCODE_LATIN1)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_QueryCert(strOut, nc, strFileName, strQuery, SAT_ENCODE_LATIN1)
    If nc > 0 Then
        satQueryCert = strOut
    End If
End Function

Public Function satSignXmlToString(strXmlData As String, strKeyFile As String, strPassword As String, strCertFile As String, nOptions As Long) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_SignXmlToString("", 0, strXmlData, strKeyFile, strPassword, strCertFile, nOptions)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_SignXmlToString(strOut, nc, strXmlData, strKeyFile, strPassword, strCertFile, nOptions)
    If nc > 0 Then
        satSignXmlToString = strOut
    End If
End Function

' Added [v9.2]
Public Function satSignXmlToBytes(strXmlData As String, strKeyFile As String, strPassword As String, strCertFile As String, nOptions As Long) As Byte()
    Dim nb As Long
    Dim abOut() As Byte
    satSignXmlToBytes = vbNullString    ' Ensure return value is always valid
    nb = SAT_SignXmlToBytes(ByVal 0&, 0, strXmlData, strKeyFile, strPassword, strCertFile, nOptions)
    If nb <= 0 Then Exit Function
    ReDim Preserve abOut(nb - 1)    ' Note length quirk for VB6/VBA
    nb = SAT_SignXmlToBytes(abOut(0), nb, strXmlData, strKeyFile, strPassword, strCertFile, nOptions)
    If nb > 0 Then
        satSignXmlToBytes = abOut
    End If
End Function

Public Function satUuid() As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_Uuid("", 0, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_Uuid(strOut, nc, 0)
    If nc > 0 Then
        satUuid = strOut
    End If
End Function

Public Function satAsciify(strXmlFile As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_Asciify("", 0, strXmlFile, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_Asciify(strOut, nc, strXmlFile, 0)
    If nc > 0 Then
        satAsciify = strOut
    End If
End Function

Public Function satInsertCertToString(strXmlFile As String, strCertFile As String)
    Dim nc As Long
    Dim strOut As String
    nc = SAT_InsertCertToString("", 0, strXmlFile, strCertFile, 0)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_InsertCertToString(strOut, nc, strXmlFile, strCertFile, 0)
    If nc > 0 Then
        satInsertCertToString = strOut
    End If
End Function


' **********************************************
' Variants for TimbreFiscalDigital (TFD)
' **********************************************

Public Function tfdMakePipeStringFromXml(strXmlFile As String) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_MakePipeStringFromXml("", 0, strXmlFile, SAT_TFD)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_MakePipeStringFromXml(strOut, nc, strXmlFile, SAT_TFD)
    If nc > 0 Then
        tfdMakePipeStringFromXml = Trim(strOut)
    End If
End Function

Public Function tfdMakeDigestFromXml(strXmlFile As String, Optional HashAlg As HashAlgorithm = 0) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_MakeDigestFromXml("", 0, strXmlFile, HashAlg + SAT_TFD)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_MakeDigestFromXml(strOut, nc, strXmlFile, HashAlg + SAT_TFD)
    If nc > 0 Then
        tfdMakeDigestFromXml = strOut
    End If
End Function

Public Function tfdExtractDigestFromSignature(strXmlFile As String, strCertFile As String) As String
' NB Certificate file is mandatory for TFD.
    Dim nc As Long
    Dim strOut As String
    nc = SAT_ExtractDigestFromSignature("", 0, strXmlFile, strCertFile, SAT_TFD)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_ExtractDigestFromSignature(strOut, nc, strXmlFile, strCertFile, SAT_TFD)
    If nc > 0 Then
        tfdExtractDigestFromSignature = strOut
    End If
End Function

Public Function tfdMakeSignatureFromXml(strXmlFile As String, strKeyFile As String, strPassword As String, Optional HashAlg As HashAlgorithm = 0) As String
    Dim nc As Long
    Dim strOut As String
    nc = SAT_MakeSignatureFromXmlEx("", 0, strXmlFile, strKeyFile, strPassword, HashAlg + SAT_TFD)
    If nc <= 0 Then Exit Function
    strOut = String(nc, " ")
    nc = SAT_MakeSignatureFromXmlEx(strOut, nc, strXmlFile, strKeyFile, strPassword, HashAlg + SAT_TFD)
    If nc > 0 Then
        tfdMakeSignatureFromXml = strOut
    End If
End Function

Public Function tfdVerifySignature(strXmlFile As String, strCertFile As String) As Long
' NB Certificate file is mandatory for TFD.
    tfdVerifySignature = SAT_VerifySignature(strXmlFile, strCertFile, SAT_TFD)
End Function