Attribute VB_Name = "FirmaSatTests"

' **************************** COPYRIGHT NOTICE ****************************
' * Copyright (C) 2010 DI Management Services Pty Limited.
' * All rights reserved. <www.di-mgt.com.au> <www.cryptosys.net>
' *   $Id: FirmaSatTests.bas $
' *   Last updated:
' *   $Date: 2010-10-30 12:16 $
' *   $Version: 2.1.0 $
' ************************* END OF COPYRIGHT NOTICE ************************

' Some tests using the FirmaSAT VB6/VBA interface.
' Requires certain files to exist in the current working directory.
' Direct calls to the DLL begin with "SAT_", wrapper functions begin with "sat"

' [v2.1] Added options for SHA-1 message digest algorithm

Option Explicit
Option Base 0

Public Sub General_Tests()
    Dim n As Long
    Dim i 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 attributeName As String
    Dim elementName As String
    
    ' Check if all required files exist in the CWD
    If Not RequiredFilesExist() Then
        MsgBox "Required files cannot be found in current working directory.", vbCritical
        Exit Sub
    End If
    
    Debug.Print ("GENERAL FUNCTIONS:")
    Debug.Print ("Interrogate the core diFirmaSat DLL:")
    n = SAT_Version()
    Debug.Print "Version=" & n
    ch = Chr(SAT_LicenceType())
    Debug.Print "LicenceType=" & ch
    Debug.Print "ModuleName=" & satModuleName()
    Debug.Print "CompileTime=" & satCompileTime()

    Debug.Print (vbLf & "Interrogate the underlying CryptoSys PKI DLL:")
    n = SAT_PKIVersion()
    Debug.Print "SAT_PKIVersion returns " & n
    Debug.Print "PKIModuleName=" & satPKIModuleName()
    Debug.Print "PKICompileTime=" & satPKICompileTime()
    
    Debug.Print (vbLf & "TRY VALIDATING XML FILES:")
    Debug.Print ("1. A valid one:")
    fname = "Muestra_v2_signed2.xml"
    n = SAT_ValidateXml(fname, 0)
    Debug.Print "SAT_ValidateXml(" & fname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_ValidateXml failed")
    
    Debug.Print ("2. An invalid one:")
    fname = "Muestra_v2_bad.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 & "FORM THE PIPESTRING FROM AN XML FILE:")
    fname = "Muestra_v2_signed2.xml"
    s = satMakePipeStringFromXml(fname)
    Debug.Print "MakePipeStringFromXml(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_MakePipeStringFromXml failed")
    
    Debug.Print (vbLf & "SIGN AN XML FILE:")
    fname = "Muestra_v2_base2.xml"
    newname = "Muestra_v2_signed_new.xml"
    keyfile = "aaa010101aaa_CSD_01.key"
    password = "a0123456789"    ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
    certfile = "aaa010101aaa_CSD_01.cer"
    n = SAT_SignXml(newname, fname, keyfile, password, certfile, 0)
    Debug.Print "SAT_SignXml('" & fname & "'-->'" & newname & "') returns " & n
    Call Our_Assert(n = 0, "SAT_SignXml failed")
    ' Did we make a valid XML file?
    n = SAT_ValidateXml(newname, 0)
    Debug.Print "SAT_ValidateXml(" & newname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_ValidateXml failed")

    Debug.Print (vbLf & "VERIFY A SIGNATURE IN AN XML FILE:")
    Debug.Print ("1. One we know is good:")
    fname = "Muestra_v2_signed2.xml"
    n = satVerifySignature(fname)
    Debug.Print "SAT_VerifySignature(" & fname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_VerifySignature failed")

    Debug.Print ("2. One we just made, so it should be good:")
    fname = newname
    n = satVerifySignature(fname)
    Debug.Print "SAT_VerifySignature(" & fname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_VerifySignature failed")
    
    Debug.Print (vbLf & "FORM THE DIGEST OF THE PIPESTRING IN AN XML FILE:")
    fname = "Muestra_v2_signed2.xml"
    s = satMakeDigestFromXml(fname)
    Debug.Print "MakeDigestFromXml(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_MakeDigestFromXml failed")

    Debug.Print (vbLf & "EXTRACT THE DIGEST FROM THE SIGNATURE IN AN XML FILE:")
    fname = "Muestra_v2_signed2.xml"
    s = satExtractDigestFromSignature(fname)
    Debug.Print "ExtractDigestFromSignature(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_ExtractDigestFromSignature failed")

    Debug.Print (vbLf & "EXTRACT AN ATTRIBUTE FROM AN XML FILE:")
    fname = "Muestra_v2_signed2.xml"
    elementName = "Comprobante"
    attributeName = "sello"
    s = satGetXmlAttribute(fname, attributeName, elementName)
    Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetXmlAttribute failed")
    
    Debug.Print (vbLf & "GET DETAILS OF X.509 CERTIFICATE:")
    Debug.Print ("1. From embedded `certificado` in XML")
    fname = "Muestra_v2_signed2.xml"
    s = satGetCertNumber(fname)
    Debug.Print "GetCertNumber(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetCertNumber failed")
    s = satGetCertExpiry(fname)
    Debug.Print "GetCertExpiry(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetCertExpiry failed")

    Debug.Print ("2. From X.509 file")
    fname = "aaa010101aaa_CSD_01.cer"
    s = satGetCertNumber(fname)
    Debug.Print "GetCertNumber(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetCertNumber failed")
    s = satGetCertExpiry(fname)
    Debug.Print "GetCertExpiry(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetCertExpiry failed")
    
    Debug.Print (vbLf & "GET CERTIFICATE AS A BASE64 STRING:")
    fname = "aaa010101aaa_CSD_01.cer"
    s = satGetCertAsString(fname)
    Debug.Print "GetCertAsString(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetCertAsString failed")
    Debug.Print "Len(GetCertAsString(" & fname & "))=" & Len(s)
    ' Compare against string from XML file
    fname = "Muestra_v2_signed2.xml"
    s1 = satGetCertAsString(fname)
    Debug.Print "Len(GetCertAsString(" & fname & "))=" & Len(s1)
    Call Our_Assert(Len(s1) > 0, "SAT_GetCertAsString failed")
    Call Our_Assert(StrComp(s, s1, vbTextCompare) = 0, "SAT_GetCertAsString failed")

    Debug.Print (vbLf & "MAKE A SIGNATURE FROM A BASE XML FILE:")
    fname = "Muestra_v2_base2.xml"
    keyfile = "aaa010101aaa_CSD_01.key"
    password = "a0123456789"    ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
    s = satMakeSignatureFromXml(fname, keyfile, password)
    Debug.Print "MakeSignatureFromXml(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_MakeSignatureFromXml failed")

    Debug.Print (vbLf & "SIGN A DETALLISTA XML FILE:")
    fname = "detallista_base.xml"
    newname = "detallista-new-signed.xml"
    keyfile = "aaa010101aaa_CSD_01.key"
    password = "a0123456789"
    ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
    certfile = "aaa010101aaa_CSD_01.cer"
    n = SAT_SignXml(newname, fname, keyfile, password, certfile, 0)
    Debug.Print "SAT_SignXml('" & fname & "'-->'" & newname & "') returns " & n
    Call Our_Assert(n = 0, "SAT_SignXml failed")
    ' Did we make a valid XML file?
    n = SAT_ValidateXml(newname, 0)
    Debug.Print "SAT_ValidateXml(" & newname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_ValidateXml failed")
    n = satVerifySignature(newname)
    Debug.Print "SAT_VerifySignature(" & newname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_VerifySignature failed")
    
    Debug.Print (vbLf & "EXTRACT AN ATTRIBUTE FROM A DETALLISTA XML FILE:")
    fname = "detallista-new-signed.xml"
    elementName = "detallista:detallista"
    attributeName = "documentStructureVersion"
    s = satGetXmlAttribute(fname, attributeName, elementName)
    Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetXmlAttribute failed")
    Call Our_Assert(StrComp(s, "AMC8.1") = 0, "Invalid detallista.documentStructureVersion")
    
    ' [v2.1] Added SHA-1 options.
    Debug.Print (vbLf & "NEW SHA-1 OPTIONS IN V2.1...")
    
    Debug.Print (vbLf & "SIGN AN XML FILE USING SHA-1:")
    fname = "Muestra_v2_base2.xml"
    newname = "Muestra_v2_signed_sha1.xml"
    keyfile = "aaa010101aaa_CSD_01.key"
    password = "a0123456789"    ' CAUTION: DO NOT HARD-CODE REAL PASSWORDS!
    certfile = "aaa010101aaa_CSD_01.cer"
    n = SAT_SignXml(newname, fname, keyfile, password, certfile, SAT_HASH_SHA1)
    Debug.Print "SAT_SignXml('" & fname & "'-->'" & newname & "') returns " & n
    Call Our_Assert(n = 0, "SAT_SignXml failed")
    ' Did we make a valid XML file?
    n = SAT_ValidateXml(newname, 0)
    Debug.Print "SAT_ValidateXml(" & newname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_ValidateXml failed")
    
    Debug.Print (vbLf & "VERIFY A SHA-1 SIGNATURE IN AN XML FILE:")
    fname = newname
    n = satVerifySignature(fname)
    Debug.Print "SAT_VerifySignature(" & fname & ") returns " & n
    Call Our_Assert(n = 0, "SAT_VerifySignature failed")
    
    Debug.Print (vbLf & "EXTRACT THE SELLO ATTRIBUTE FROM AN XML FILE:")
    fname = newname
    elementName = "Comprobante"
    attributeName = "sello"
    s = satGetXmlAttribute(fname, attributeName, elementName)
    Debug.Print "SAT_GetXmlAttribute('" & fname & "'," & attributeName & "," & elementName & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_GetXmlAttribute failed")
    
    Debug.Print (vbLf & "EXTRACT THE DIGEST FROM THE SIGNATURE IN AN XML FILE:")
    fname = "Muestra_v2_signed_sha1.xml"
    s = satExtractDigestFromSignature(fname)
    Debug.Print "ExtractDigestFromSignature(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_ExtractDigestFromSignature failed")
    
    Debug.Print (vbLf & "FORM THE SHA-1 DIGEST OF THE PIPESTRING IN AN XML FILE:")
    fname = "Muestra_v2_signed2.xml"
    s = satMakeDigestFromXml(fname, SAT_HASH_SHA1)
    Debug.Print "MakeDigestFromXml(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_MakeDigestFromXml failed")
    
    Debug.Print (vbLf & "MAKE A SHA-1 SIGNATURE FROM A BASE XML FILE:")
    fname = "Muestra_v2_base2.xml"
    s = satMakeSignatureFromXml(fname, keyfile, password, SAT_HASH_SHA1)
    Debug.Print "MakeSignatureFromXml(" & fname & ")=" & vbLf & s
    Call Our_Assert(Len(s) > 0, "SAT_MakeSignatureFromXml failed")


' Change "#If 0" to "#If 1" to activate this
#If 0 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

End Sub

' *********************
' UTILITIES USED HERE *
' *********************

Public Function RequiredFilesExist() As Boolean
' Check for required files in current working directory
    Dim arrFiles As Variant
    Dim vnt As Variant
    
    arrFiles = Array( _
        "aaa010101aaa_CSD_01.cer", _
        "aaa010101aaa_CSD_01.key", _
        "detallista_base.xml", _
        "Muestra_v2_bad.xml", _
        "Muestra_v2_base2.xml", _
        "Muestra_v2_signed2.xml")
    For Each vnt In arrFiles
        If Not IsNormalFile(CStr(vnt)) Then
            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