Attribute VB_Name = "basSMIMEex"
Option Explicit

' $Id: basSMIMEex $
' Reproduces examples from RFC 4134 "Examples of S/MIME Messages"
'   Last Updated:
'   $Date: 2012-01-14 11:11:00 $
'   $Revision: 3.8.0 $

' Output is directed to the Immediate Window using oDebug.PPrint
' Errors are flagged with a MsgBox and then a Stop

' Requires these test files to exist in the same directory as the executable:
'   4.2.bin
'   AlicePrivRSASign.pri
'   AliceRSASignByCarl.cer
'   BobPrivRSAEncrypt.pri
'   BobRSASignByCarl.cer
'   CarlPrivRSASign.pri
'   CarlRSASelf.cer
'   excontent.txt

' Functions further down depend on files being created by previous functions.

Private m_strTestDir As String
Public oDebug As New CDebug

' THE MAIN PROGRAM OF TESTS...
Public Function smime_DoAll(strPath As String)
' Creates a new temp dir
' Copies test files to it from current directory
' Then does a series of tests based on "Examples of S/MIME Messages"
On Error GoTo OnError
    Dim strTestDir As String
    strTestDir = SetupTestDir(strPath)
    oDebug.PPrint "Created new test folder '" & strTestDir & "'"
    smime_Ex5_1_MakeEnvData
    smime_Ex5_1b_MakeEnvDataFromString
    SavePrivateKeys
    smime_Ex5_1_ReadToFile
    smime_Ex5_1_ReadToString
    smime_Ex4_2_MakeSigData
    smime_Ex4_2_MakeSigDataWithMD5
    smime_MakeDetachedSig
    smime_ReadSigData
    smime_ReadSigDataIntoString
    smime_GetSigDataDigest
    smime_GetSigDataDigestMD5
    sime_GetDigestFromDetSig
    smime_FullSigDataDigestCheck
    smime_FullSigDataDigestCheckMD5
    Test_DecryptRaw
    Test_X509_CertThumb
    Test_X509_CertIsValidNow
    Test_X509_VerifyCert
    Test_X509_QueryCert
    smime_Ex4_2_MakeSigDataWithSHA256
    Show_Version
   
    oDebug.PPrint ""
    oDebug.PPrint "All done."
    oDebug.PPrint "Files saved in temp folder " & strTestDir
    ChDir ".."
    Call PromptToKillFolder(strTestDir)

Done:
    Exit Function
OnError:
    Dim sErrMsg As String
    sErrMsg = "Error " & Err.Number & " has occurred:" & vbCrLf & Err.Description
    Select Case Err.Number
    Case 75
        sErrMsg = sErrMsg & vbCrLf & vbCrLf _
            & "You do not have permission to create the test sub-folder here. Unzip the test files in a different directory."
    Case 53
        sErrMsg = sErrMsg & vbCrLf & vbCrLf _
            & "A required test file is missing. Make sure the test files from smimetestfiles.zip are in the same folder as the executable"
    End Select
    MsgBox sErrMsg, vbCritical
    Resume Done
End Function

' FILE AND DIRECTORY ADMIN STUFF...
Public Function SetupTestDir(strPath As String) As String
    Dim strTestDir As String
    Dim nRand As Long
    Dim strSrcDir As String
    Dim strDestDir As String
    
    Randomize
    nRand = RNG_Number(0, &H7FFFFFFF)
    
    ' Create a new random test sub-dir
    strTestDir = strPath & "\pkitest." & Hex(nRand)
    MkDir strTestDir
    
    ' Make this the current dir
    ChDir strTestDir
    
    oDebug.PPrint vbCrLf & "Setting up test files in directory " & strTestDir & "..."
    
    ' Set default path to empty
    m_strTestDir = ""
    
    ' Copy files from app dir to test dir
    CopyFileToTest "AliceRSASignByCarl.cer", App.Path, strTestDir
    CopyFileToTest "AlicePrivRSASign.pri", App.Path, strTestDir
    CopyFileToTest "BobRSASignByCarl.cer", App.Path, strTestDir
    CopyFileToTest "BobPrivRSAEncrypt.pri", App.Path, strTestDir
    CopyFileToTest "CarlRSASelf.cer", App.Path, strTestDir
    CopyFileToTest "CarlPrivRSASign.pri", App.Path, strTestDir
    CopyFileToTest "excontent.txt", App.Path, strTestDir
    CopyFileToTest "4.2.bin", App.Path, strTestDir
    ' Write a text file as a memo
    WriteFileFromString "!ThisFolderIsSafeToDelete.txt", _
        "This folder was created as a test for the CryptoSys PKI Toolkit by the program '" _
        & App.EXEName & "'. The folder and all files in it may be safely deleted at any time."
    
    SetupTestDir = strTestDir
End Function

Public Function PromptToKillFolder(strFolder As String)
    Dim sMsg As String
    
    sMsg = "The directory '" & strFolder & "' has been created by this test program." _
        & vbCrLf & vbCrLf & "Do you want to remove it now?"
    
    If vbYes = MsgBox(sMsg, vbYesNo, "Remove test directory") Then
        If apiKillDirectory(strFolder) Then
            oDebug.PPrint "Temp folder has been deleted."
        End If
    End If
    
End Function

Public Function CopyFileToTest(strFileName As String, ByVal strSrcDir As String, ByVal strDestDir As String)
    strSrcDir = Trim(strSrcDir)
    If Right(strSrcDir, 1) = "\" Then
       strSrcDir = Left(strSrcDir, Len(strSrcDir) - 1)
    End If
    strDestDir = Trim(strDestDir)
    If Right(strDestDir, 1) = "\" Then
       strDestDir = Left(strDestDir, Len(strDestDir) - 1)
    End If
    
    FileCopy strSrcDir & "\" & strFileName, strDestDir & "\" & strFileName
        
End Function

Public Function TrimNull(strToTrim As String) As String
' Trims a string that might contain a NULL character
    Dim nPos As Long
    
    TrimNull = strToTrim
    nPos = InStr(TrimNull, Chr$(0))
    If nPos > 0 Then
        TrimNull = Left$(TrimNull, nPos - 1)
    End If
End Function

' THE REAL PKI TESTS...
Public Function smime_Ex5_1_MakeEnvData()
' Reproduces example 5.1 - EnvelopedData from Alice to Bob
' of ExContent using TripleDES and RSA.
' NB output will always be different from smime-examples
' because the content-encryption key, encryption-IV
' and eContent will be different each time.

    Dim nRet As Long
    Dim strOutputFile As String
    Dim strInputFile As String
    Dim strCertFile As String
    Dim strQuery As String
    Dim strResult As String
    
    oDebug.PPrint vbCrLf & "Alice sends EnvelopedData (encrypted data) to Bob..."
    
    strOutputFile = m_strTestDir & "cmsalice2bob.p7m"
    strInputFile = m_strTestDir & "excontent.txt"
    strCertFile = m_strTestDir & "BobRSASignByCarl.cer"
    ' This should return 1 (indicating one successful recipient)
    nRet = CMS_MakeEnvData(strOutputFile, strInputFile, strCertFile, "", 0, 0)
    oDebug.PPrint "CMS_MakeEnvData returns " & nRet & " (expected 1)"
    If nRet = 1 Then
        oDebug.PPrint "Created file " & strOutputFile
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_MakeEnvData"
        Stop
    End If

    ' Check the algorithm details in the file we just made
    strResult = String(64, " ")
    strQuery = "keyEncryptionAlgorithm"
    nRet = CMS_QueryEnvData(strResult, Len(strResult), strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
        Stop
    End If
    oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    strResult = String(64, " ")
    strQuery = "contentEncryptionAlgorithm"
    nRet = CMS_QueryEnvData(strResult, Len(strResult), strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
        Stop
    End If
    oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"

End Function


Public Function smime_Ex5_1b_MakeEnvDataFromString()
' Reproduces example 5.1 - EnvelopedData from Alice to Bob
' of ExContent using TripleDES and RSA.

    Dim nRet As Long
    Dim strOutputFile As String
    Dim strQuery As String
    
    oDebug.PPrint vbCrLf & "Alice sends EnvelopedData to Bob using string input..."
    
    strOutputFile = m_strTestDir & "cmsalice2bob1.p7m"
    ' This should return 1 (indicating one successful recipient)
    nRet = CMS_MakeEnvDataFromString(strOutputFile, _
        "This is some sample content.", m_strTestDir & "BobRSASignByCarl.cer", "", 0, 0)
    oDebug.PPrint "CMS_MakeEnvDataFromString returns " & nRet & " (expected 1)"
    If nRet = 1 Then
        oDebug.PPrint "Created file " & strOutputFile
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_MakeEnvDataFromString"
        Stop
    End If

    ' Check the algorithm details in the file we just made
    ' (these particular queries don't need a result string)
    strQuery = "countOfRecipientInfos"
    nRet = CMS_QueryEnvData(vbNullString, 0, strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
        Stop
    End If
    oDebug.PPrint strQuery & "=" & nRet
    strQuery = "sizeofEncryptedContent"
    nRet = CMS_QueryEnvData(vbNullString, 0, strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QueryEnvData"
        Stop
    End If
    oDebug.PPrint strQuery & "=" & nRet

End Function

' The private keys (*.pri) given with smime-examples are in
' unencrypted private-key-info format
' We want to save them encrypted with a password
' Use a generic function to do this
Public Function CopyPriKeyToEncFile(strEPKFile As String, strPRIFile As String, strPassword As String) As Boolean
    Dim strPrivateKey As String
    Dim strPK1 As String
    Dim nKeyLen As String
    Dim nRet As Long
    
    ' Read in unencrypted PrivateKeyInfo data
    nKeyLen = RSA_ReadPrivateKeyInfo("", 0, strPRIFile, 0)
    If nKeyLen <= 0 Then
        MsgBox pkiGetLastError(), vbCritical, "RSA_ReadPrivateKeyInfo"
        Exit Function
    End If
    strPrivateKey = String(nKeyLen, " ")
    nRet = RSA_ReadPrivateKeyInfo(strPrivateKey, nKeyLen, strPRIFile, 0)
    If nRet <= 0 Then
        MsgBox pkiGetLastError(), vbCritical, "RSA_ReadPrivateKeyInfo"
        Exit Function
    End If
    oDebug.PPrint "RSA_KeyBits(strPrivateKey)=" & RSA_KeyBits(strPrivateKey)
    
    ' Now we save it with a password
    nRet = RSA_SaveEncPrivateKey(strEPKFile, strPrivateKey, 1000, strPassword, 0)
    oDebug.PPrint "RSA_SaveEncPrivateKey returns " & nRet
    
    ' Check we can read it
    strPK1 = rsaReadPrivateKey(strEPKFile, strPassword)
    oDebug.PPrint "RSA_KeyBits(strPK1)=" & RSA_KeyBits(strPK1)
    oDebug.PPrint "RSA_KeyHashCode(strPK1)       =" & Hex(RSA_KeyHashCode(strPK1))
    oDebug.PPrint "RSA_KeyHashCode(strPrivateKey)=" & Hex(RSA_KeyHashCode(strPrivateKey))
    ' NB: as of ver 3.0 we can no longer compare internal key strings directly
    ''If strPK1 <> strPrivateKey Then
    ' so we use the KeyHashCode
    If RSA_KeyHashCode(strPK1) <> RSA_KeyHashCode(strPrivateKey) Then
        MsgBox "Private keys do not match!", vbCritical, "CopyPriKeyToEncFile"
        Stop
    Else
        CopyPriKeyToEncFile = True
    End If

End Function

Public Function SavePrivateKeys()
    
    oDebug.PPrint vbCrLf & "Converting and saving encrypted private keys..."
    If CopyPriKeyToEncFile(m_strTestDir & "AlicePrivRSASign.epk", m_strTestDir & "AlicePrivRSASign.pri", "password") Then
        oDebug.PPrint "Encrypted Alice's private key"
    End If
    If CopyPriKeyToEncFile(m_strTestDir & "BobPrivRSAEncrypt.epk", m_strTestDir & "BobPrivRSAEncrypt.pri", "password") Then
        oDebug.PPrint "Encrypted Bob's private key"
    End If
    If CopyPriKeyToEncFile(m_strTestDir & "CarlPrivRSASign.epk", m_strTestDir & "CarlPrivRSASign.pri", "password") Then
        oDebug.PPrint "Encrypted Carl's private key"
    End If
    
End Function


Public Function smime_Ex5_1_ReadToFile()
' Bob reads the enveloped-data message sent by Alice
' Wrting output directly to a file

    Dim nRet As Long
    Dim strFileIn As String
    Dim strFileOut As String
    Dim strPrivateKey As String
    Dim strCheck As String
    
    oDebug.PPrint vbCrLf & "Bob reads the enveloped-data message sent by Alice..."
    
    ' Bob reads his private key into a string
    strPrivateKey = rsaReadPrivateKey(m_strTestDir & "BobPrivRSAEncrypt.epk", "password")
    If Len(strPrivateKey) = 0 Then
        MsgBox "Cannot read private key", vbCritical
        Stop
        Exit Function
    End If
    
    ' Decrypt the input file; send plaintext to new output file
    strFileIn = m_strTestDir & "cmsalice2bob.p7m"
    strFileOut = m_strTestDir & "fromalice.txt"
    nRet = CMS_ReadEnvData(strFileOut, strFileIn, "", strPrivateKey, 0)
    oDebug.PPrint "CMS_ReadEnvData returns " & nRet & " (expected 0)"
    If nRet = 0 Then
        oDebug.PPrint "Created plaintext file " & strFileOut
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadEnvData"
        Stop
    End If
    
    ' Clean up
    strPrivateKey = wipeString(strPrivateKey)
    

End Function

Public Function smime_Ex5_1_ReadToString()
' Bob reads the enveloped-data message sent by Alice
' directly into a string

    Dim nRet As Long
    Dim strPrivateKey As String
    Dim strFileIn As String
    Dim strDataOut As String
    Dim nDataLen As Long
    
    oDebug.PPrint vbCrLf & "Bob reads the enveloped-data message sent by Alice (into a string)..."
    
    ' First, Bob reads his private key into a string
    strPrivateKey = rsaReadPrivateKey(m_strTestDir & "BobPrivRSAEncrypt.epk", "password")
    If Len(strPrivateKey) = 0 Then
        MsgBox "Cannot read private key", vbCritical
        Stop
        Exit Function
    End If
    
    ' Decrypt the input file - how long is the plaintext?
    strFileIn = m_strTestDir & "cmsalice2bob.p7m"
    nDataLen = CMS_ReadEnvDataToString("", 0, strFileIn, "", strPrivateKey, 0)
    oDebug.PPrint "CMS_ReadEnvDataToString returns " & nDataLen & " (expected > 0)"
    
    If nDataLen <= 0 Then
        GoTo CleanUp
    End If
    
    ' Pre-dimension string and read in the plaintext
    strDataOut = String(nDataLen, " ")
    nDataLen = CMS_ReadEnvDataToString(strDataOut, nDataLen, strFileIn, "", strPrivateKey, 0)
    oDebug.PPrint "CMS_ReadEnvDataToString returns " & nDataLen
    If nDataLen > 0 Then
        oDebug.PPrint "Plaintext is '" & strDataOut & "'"
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadEnvDataToString"
        Stop
    End If
    
CleanUp:
    WIPE_String strPrivateKey, Len(strPrivateKey)
    strPrivateKey = ""

End Function

Public Function smime_Ex4_2_MakeSigData()
' This example should reproduce exactly the signed-data
' file from Example 4.2
' The output should be identical to 4.2.bin
    Dim strEPKFile As String
    Dim strPrivateKey As String
    Dim nRet As Long
    Dim strInputFile As String
    Dim strOutputFile As String
    Dim strCertFile As String
    
    oDebug.PPrint vbCrLf & "Alice makes signed-data file..."
    
    strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
    strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
    strInputFile = m_strTestDir & "excontent.txt"
    strOutputFile = m_strTestDir & "BasicSignByAlice.p7s"
    
    ' Alice reads in her private key (which we encrypted earlier)
    strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
    If Len(strPrivateKey) = 0 Then
        MsgBox "Cannot read private key", vbCritical
        Stop
        Exit Function
    End If
    
    ' Now we can sign our message
    nRet = CMS_MakeSigData(strOutputFile, strInputFile, strCertFile, strPrivateKey, 0)
    oDebug.PPrint "CMS_MakeSigData returns " & nRet & " (expected 0)"
    If nRet = 0 Then
        oDebug.PPrint "Created signed-data file " & strOutputFile
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_MakeSigData"
        Stop
    End If

End Function

Public Function smime_Ex4_2_MakeSigDataWithMD5()
' As above but using input directly from a string and using
' MD5 instead of SHA-1
    Dim strEPKFile As String
    Dim strPrivateKey As String
    Dim nKeyLen As Long
    Dim nRet As Long
    Dim strInputFile As String
    Dim strOutputFile As String
    Dim strCertFile As String
    
    oDebug.PPrint vbCrLf & "Alice makes signed-data file from string input and uses MD5..."
    
    strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
    strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
    strOutputFile = m_strTestDir & "BasicSignByAliceMD5.p7s"
    
    ' Alice reads in her private string (which we encrypted earlier)
    strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
    If Len(strPrivateKey) = 0 Then
        MsgBox "Cannot read private key", vbCritical
        Stop
        Exit Function
    End If
    
    ' Now we can sign our message using MD5
    nRet = CMS_MakeSigDataFromString(strOutputFile, "This is some sample content.", _
        strCertFile, strPrivateKey, PKI_HASH_MD5)
    oDebug.PPrint "CMS_MakeSigDataFromString returns " & nRet & " (expected 0)"
    If nRet = 0 Then
        oDebug.PPrint "Created signed-data file " & strOutputFile
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_MakeSigDataFromString"
        Stop
    End If

End Function


Public Function smime_MakeDetachedSig()
' Alice creates a detached signature starting with the message digest in hex format
    Dim nRet As Long
    Dim strEPKFile As String
    Dim strCertFile As String
    Dim strOutFile As String
    Dim strHexDigest As String
    Dim strPrivateKey As String
    
    oDebug.PPrint vbCrLf & "Alice creates a detached signature starting with the message digest in hex format..."
    
    strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
    strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
    strOutFile = m_strTestDir & "DetSignByAlice.p7s"
    strHexDigest = "406aec085279ba6e16022d9e0629c0229687dd48"
    
    ' First, Alice reads her private key into a string
    strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
    If Len(strPrivateKey) = 0 Then
        MsgBox "Cannot read private key"
        Stop
        Exit Function
    End If

    ' Alice makes a detached signature using
    ' the hash of the content and her private key
    nRet = CMS_MakeDetachedSig(strOutFile, strHexDigest, _
        strCertFile, strPrivateKey, 0)
    oDebug.PPrint "CMS_MakeDetachedSig returns " & nRet & " (expected 0)"
    If nRet = 0 Then
        oDebug.PPrint "Created detached signature file " & strOutFile
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_MakeDetachedSig"
        Stop
    End If
    
End Function

Public Function smime_ReadSigData()
' Read Alice's signed-data, writing directly to a file
    Dim nRet As Long
    Dim strFileIn As String
    Dim strFileOut As String
    
    oDebug.PPrint vbCrLf & "Read Alice's signed-data, writing directly to a file..."
    
    strFileIn = m_strTestDir & "BasicSignByAlice.p7s"
    strFileOut = m_strTestDir & "BasicSignByAlice.dat"
    nRet = CMS_ReadSigData(strFileOut, strFileIn, 0)
    oDebug.PPrint "CMS_ReadSigData returns " & nRet & " (expected > 0)"
    If nRet > 0 Then
        oDebug.PPrint nRet & " bytes of signed data are in file " & strFileOut
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigData"
        Stop
    End If
    
End Function

Public Function smime_ReadSigDataIntoString()
' Extract signed data from original file, reading into a string
    Dim strFileIn As String
    Dim strData As String
    Dim nDataLen As Long
    
    oDebug.PPrint vbCrLf & "Extract signed data from original file, reading into a string..."
    
    strFileIn = m_strTestDir & "4.2.bin"
    ' How long is the content to be read?
    nDataLen = CMS_ReadSigDataToString("", 0, strFileIn, 0)
    oDebug.PPrint "CMS_ReadSigDataToString returns " & nDataLen & " (expected > 0)"
    If nDataLen <= 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
        Stop
        Exit Function
    End If
    ' Pre-dimension string to receive data then get it
    strData = String(nDataLen, " ")
    nDataLen = CMS_ReadSigDataToString(strData, nDataLen, strFileIn, 0)
    If nDataLen > 0 Then
        oDebug.PPrint "Signed data is [" & strData & "]"
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
        Stop
    End If
    
End Function


Public Function smime_GetSigDataDigest()
' Get the message digest from the original signed-data file
    Dim strCmsFile As String
    Dim strHexDigest As String
    Dim nDigAlg As Long
    
    oDebug.PPrint vbCrLf & "Get the message digest from the original signed-data file..."
    
    strCmsFile = m_strTestDir & "4.2.bin"
    
    ' Dimension string ready for longest possible
    strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
    nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
    ' Should return zero for SHA-1 algorithm
    oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg & " (expected 0)"
    If nDigAlg <> 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
        Stop
    End If
    ' We need to trim this string
    strHexDigest = TrimNull(strHexDigest)
    oDebug.PPrint "Digest is [" & strHexDigest & "]"

End Function

Public Function smime_GetSigDataDigestMD5()
' As above but this time it's an MD5 digest
    Dim strCmsFile As String
    Dim strHexDigest As String
    Dim nDigAlg As Long
    
    oDebug.PPrint vbCrLf & "As above but this time it's an MD5 digest..."
    
    strCmsFile = m_strTestDir & "BasicSignByAliceMD5.p7s"
    
    ' Dimension string ready for longest possible
    strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
    nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
    oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg & " (expected 1)"
    If nDigAlg <> 1 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
        Stop
    End If
    ' We need to trim this string
    strHexDigest = TrimNull(strHexDigest)
    oDebug.PPrint "Digest is [" & strHexDigest & "]"

End Function

Public Function sime_GetDigestFromDetSig()
' Get the digest value from the detached signature
    Dim nDigAlg As Long
    Dim strCmsFile As String
    Dim strHexDigest As String
    
    oDebug.PPrint vbCrLf & "Get the digest value from the detached signature..."
    
    strCmsFile = m_strTestDir & "DetSignByAlice.p7s"
    
    ' Dimension string ready for longest possible
    strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
    nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
    oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg
    If nDigAlg < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
        Stop
    End If
    ' We need to trim this string
    strHexDigest = TrimNull(strHexDigest)
    oDebug.PPrint "Digest is [" & strHexDigest & "]"
    
End Function

Public Function smime_FullSigDataDigestCheck()
' Do a full check on the original signed-data object
    Dim strCmsFile As String
    Dim strHexDigest As String
    Dim nDigAlg As Long
    Dim strData As String
    Dim nDataLen As Long
    Dim strContentDigest As String
    Dim nHashLen As Long
    
    oDebug.PPrint vbCrLf & "Do a full check on the original signed-data object..."
    
    strCmsFile = m_strTestDir & "4.2.bin"
    
    ' Get the digest value
    strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
    nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
    oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg
    If nDigAlg < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
        Stop
        Exit Function
    End If
    strHexDigest = TrimNull(strHexDigest)
    oDebug.PPrint "Extracted digest is"
    oDebug.PPrint "[" & strHexDigest & "]"

    ' Go get the content - in this case it's in the signed-data object
    nDataLen = CMS_ReadSigDataToString("", 0, strCmsFile, 0)
    If nDataLen <= 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
        Stop
        Exit Function
    End If
    strData = String(nDataLen, " ")
    nDataLen = CMS_ReadSigDataToString(strData, nDataLen, strCmsFile, 0)
    oDebug.PPrint "CMS_ReadSigDataToString returns " & nDataLen
    oDebug.PPrint "Data is [" & strData & "]"
    
    ' Compute independently the hash of what we found
    strContentDigest = String(PKI_MAX_HASH_CHARS, " ")
    ' (Note how we use the digest algorithm code returned above)
    nHashLen = HASH_HexFromString(strContentDigest, Len(strContentDigest), strData, nDataLen, nDigAlg)
    oDebug.PPrint "Computed hash of content is"
    oDebug.PPrint "[" & Left$(strContentDigest, nHashLen) & "]"
    
    ' Can we match this hash digest with what we extracted from the signed-data?
    strContentDigest = Left(strContentDigest, nHashLen)
    strHexDigest = Left(strHexDigest, nHashLen)
    If strContentDigest = strHexDigest Then
        oDebug.PPrint "SUCCESS - digests match!"
    Else
        oDebug.PPrint "FAILS! - no match"
        MsgBox "Digests are not equal", vbCritical
        Stop
    End If
    
End Function

Public Function smime_FullSigDataDigestCheckMD5()
' Ditto using signed-data file with MD5 digest
    Dim strCmsFile As String
    Dim strHexDigest As String
    Dim nDigAlg As Long
    Dim strData As String
    Dim nDataLen As Long
    Dim strContentDigest As String
    Dim nHashLen As Long
    
    oDebug.PPrint vbCrLf & "Ditto using signed-data file with MD5 digest..."
    
    strCmsFile = m_strTestDir & "BasicSignByAliceMD5.p7s"
    
    ' Get the digest value
    strHexDigest = String(PKI_MAX_HASH_CHARS, " ")
    
    nDigAlg = CMS_GetSigDataDigest(strHexDigest, Len(strHexDigest), strCmsFile, "", 0)
    oDebug.PPrint "CMS_GetSigDataDigest returns " & nDigAlg
    If nDigAlg < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_GetSigDataDigest"
        Stop
        Exit Function
    End If
    oDebug.PPrint "Extracted digest is"
    oDebug.PPrint "[" & strHexDigest & "]"

    ' Go get the content - in this case it's in the signed-data object
    nDataLen = CMS_ReadSigDataToString("", 0, strCmsFile, 0)
    If nDataLen <= 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_ReadSigDataToString"
        Stop
        Exit Function
    End If
    strData = String(nDataLen, " ")
    nDataLen = CMS_ReadSigDataToString(strData, nDataLen, strCmsFile, 0)
    oDebug.PPrint "CMS_ReadSigDataToString returns " & nDataLen
    oDebug.PPrint "Data is [" & strData & "]"
    
    ' Compute independently the hash of what we found
    strContentDigest = String(PKI_MAX_HASH_CHARS, " ")
    ' (Note how we use the digest algorithm code returned above)
    nHashLen = HASH_HexFromString(strContentDigest, Len(strContentDigest), strData, nDataLen, nDigAlg)
    oDebug.PPrint "Computed hash of content is"
    oDebug.PPrint "[" & strContentDigest & "]"
    
    ' Can we match this hash digest with what we extracted from the signed-data?
    ' (remember to trim the strings to the correct length)
    strContentDigest = Left(strContentDigest, nHashLen)
    strHexDigest = Left(strHexDigest, nHashLen)
    If strContentDigest = strHexDigest Then
        oDebug.PPrint "SUCCESS - digests match!"
    Else
        oDebug.PPrint "FAILS! - no match"
        MsgBox "Digests are not equal", vbCritical
        Stop
    End If
    
End Function

Public Function Test_DecryptRaw()
' This is from Example 4.2 of smime-examples-12
    Dim sEncDataHex As String
    Dim abData() As Byte
    Dim nDataLen As Long
    Dim strCertFile As String
    Dim nLen As Long
    Dim strPublicKey As String
    Dim nRet As Long
    
    oDebug.PPrint vbCrLf & "Verify an RSA signature using Example 4.2 of smime-examples-12..."
    
    ' Cut and paste from DUMPASN1 output
    sEncDataHex = "2F 23 82 D2 F3 09 5F B8 0C 58 EB 4E" & _
        "9D BF 89 9A 81 E5 75 C4 91 3D D3 D0" & _
        "D5 7B B6 D5 FE 94 A1 8A AC E3 C4 84" & _
        "F5 CD 60 4E 27 95 F6 CF 00 86 76 75" & _
        "3F 2B F0 E7 D4 02 67 A7 F5 C7 8D 16" & _
        "04 A5 B3 B5 E7 D9 32 F0 24 EF E7 20" & _
        "44 D5 9F 07 C5 53 24 FA CE 01 1D 0F" & _
        "17 13 A7 2A 95 9D 2B E4 03 95 14 0B" & _
        "E9 39 0D BA CE 6E 9C 9E 0C E8 98 E6" & _
        "55 13 D4 68 6F D0 07 D7 A2 B1 62 4C" & _
        "E3 8F AF FD E0 D5 5D C7"
    
    ' Convert to bytes
    abData = cnvBytesFromHexStr(sEncDataHex)
    ' Check
    oDebug.PPrint cnvHexStrFromBytes(abData)

    strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
    ' Read in PublicKey as base64 string - pre-dimension first
    nLen = RSA_GetPublicKeyFromCert(vbNullString, 0, strCertFile, 0)
    If nLen <= 0 Then
        oDebug.PPrint pkiGetLastError()
        MsgBox "Unable to retrieve private key"
        Exit Function
    End If
    ' Pre-dimension the string to receive data
    strPublicKey = String(nLen, " ")
    ' Read in the Key
    nLen = RSA_GetPublicKeyFromCert(strPublicKey, Len(strPublicKey), strCertFile, 0)
    
    ' Verify using the public key
    nDataLen = UBound(abData) + 1
    oDebug.PPrint "Input:  " & cnvHexStrFromBytes(abData)
    nRet = RSA_RawPublic(abData(0), nDataLen, strPublicKey, 0)
    oDebug.PPrint "Output: " & cnvHexStrFromBytes(abData)
    ' Stripping the PKCS-1.5 header, we should get
    ' 3021300906052B0E03021A05000414406AEC085279BA6E16022D9E0629C0229687DD48
    ' which is a DigestInfo containing the 20-byte SHA-1 hash
    ' 406AEC085279BA6E16022D9E0629C0229687DD48

End Function

Public Function Test_X509_CertThumb()
    Dim nRet As Long
    Dim strCertName As String
    Dim strHexHash As String
    
    ' The Windows Certificate Manager gives the correct
    ' SHA-1 hash as 'B30C 4885 5055 C2E6 4CE3 1964 92D4 B838 31A6 B3CB'
     
    oDebug.PPrint vbCrLf & "Compute the SHA-1 `thumbprint' of an X.509 certificate..."
    
    strHexHash = String(40, " ")
    strCertName = m_strTestDir & "AliceRSASignByCarl.cer"
    nRet = X509_CertThumb(strCertName, strHexHash, Len(strHexHash), 0)
    oDebug.PPrint "X509_CertThumb returns " & nRet & " for " & strCertName
    oDebug.PPrint "Thumb  =" & strHexHash
    oDebug.PPrint "Correct=B30C48855055C2E64CE3196492D4B83831A6B3CB"
    
End Function

Public Function Test_X509_CertIsValidNow()
    Dim nRet As Long
    Dim strCertName As String
     
    oDebug.PPrint vbCrLf & "Check that an X.509 certificate is valid now..."
    
    strCertName = m_strTestDir & "AliceRSASignByCarl.cer"
    nRet = X509_CertIsValidNow(strCertName, 0)
    oDebug.PPrint "X509_CertIsValidNow returns " & nRet & " for " & strCertName
    If nRet = 0 Then
        oDebug.PPrint "Certificate is still valid"
    Else
        oDebug.PPrint "Certificate has expired or is not yet valid"
    End If
End Function

Public Function Test_X509_VerifyCert()
' Verify that Alice's certficate was signed by Carl
' Returns 0 if OK, -1 if fails to validate, or +ve if other error
    Dim nRet As Long
    
    oDebug.PPrint vbCrLf & "Verify that Alice's certficate was signed by Carl..."
    
    nRet = X509_VerifyCert(m_strTestDir & "AliceRSASignByCarl.cer", m_strTestDir & "CarlRSASelf.cer", 0)
    If nRet = 0 Then
        oDebug.PPrint "Verification is OK"
    ElseIf nRet > 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint "Cert not issued by this Issuer"
    End If
End Function

Public Function Test_X509_QueryCert()
' Query Alice's and Carl's certificates
    Dim nRet As Long
    Dim strCertName As String
    Dim strQuery As String
    Dim strResult As String
    
    oDebug.PPrint vbCrLf & "Query Alice's and Carl's certificates..."
    
    ' Make an output buffer
    strResult = String(64, " ")
    
    strCertName = m_strTestDir & "AliceRSASignByCarl.cer"
    oDebug.PPrint "Alice's Certificate:"
    strQuery = "IssuerName"
    nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
    If nRet < 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    End If
    strQuery = "SubjectName"
    nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
    If nRet < 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    End If
    strQuery = "SerialNumber"
    nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
    If nRet < 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    End If
    
    ' Repeat for Carl's cert
    strCertName = m_strTestDir & "CarlRSASelf.cer"
    oDebug.PPrint "Carl's Certificate:"
    strQuery = "IssuerName"
    nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
    If nRet < 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    End If
    strQuery = "SubjectName"
    nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
    If nRet < 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    End If
    strQuery = "SerialNumber"
    nRet = X509_QueryCert(strResult, Len(strResult), strCertName, strQuery, 0)
    If nRet < 0 Then
        oDebug.PPrint "Error: " & nRet & pkiGetLastError()
    Else
        oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    End If

End Function

Public Function smime_Ex4_2_MakeSigDataWithSHA256()
' As above but using input directly from a string and using
' SHA-256 instead of SHA-1 for the signature
' and adds Signing Time
' and then query the SigData file we made
    Dim strEPKFile As String
    Dim strPrivateKey As String
    Dim nKeyLen As Long
    Dim nRet As Long
    Dim strInputFile As String
    Dim strOutputFile As String
    Dim strCertFile As String
    Dim strQuery As String
    Dim strResult As String
    
    oDebug.PPrint vbCrLf & "Alice makes signed-data file from string input and uses SHA-256..."
    
    strEPKFile = m_strTestDir & "AlicePrivRSASign.epk"
    strCertFile = m_strTestDir & "AliceRSASignByCarl.cer"
    strOutputFile = m_strTestDir & "SignedByAliceSHA256.p7s"
    
    ' Alice reads in her private string (which we encrypted earlier)
    strPrivateKey = rsaReadPrivateKey(strEPKFile, "password")
    If Len(strPrivateKey) = 0 Then
        MsgBox "Cannot read private key", vbCritical
        Stop
        Exit Function
    End If
    
    ' Now we can sign our message using SHA-256
    nRet = CMS_MakeSigDataFromString(strOutputFile, "This is some sample content.", _
        strCertFile, strPrivateKey, PKI_HASH_SHA256 + PKI_CMS_INCLUDE_ATTRS + PKI_CMS_ADD_SIGNTIME)
    oDebug.PPrint "CMS_MakeSigDataFromString returns " & nRet & " (expected 0)"
    If nRet = 0 Then
        oDebug.PPrint "Created signed-data file " & strOutputFile
    Else
        MsgBox pkiGetLastError(), vbCritical, "CMS_MakeSigDataFromString"
        Stop
    End If
    
    ' Query the signature algorithm in the file we just made
    strResult = String(64, " ")
    strQuery = "digestAlgorithm"
    nRet = CMS_QuerySigData(strResult, Len(strResult), strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QuerySigData"
        Stop
    End If
    oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    ' And the attributes
    strResult = String(64, " ")
    strQuery = "signingTime"
    nRet = CMS_QuerySigData(strResult, Len(strResult), strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QuerySigData"
        Stop
    End If
    oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
    strResult = String(64, " ")
    strQuery = "messageDigest"
    nRet = CMS_QuerySigData(strResult, Len(strResult), strOutputFile, strQuery, 0)
    If nRet < 0 Then
        MsgBox pkiGetLastError(), vbCritical, "CMS_QuerySigData"
        Stop
    End If
    oDebug.PPrint strQuery & "='" & Left(strResult, nRet) & "'"
   
    ' And verify the signature using the sender's certificate included in the file
    nRet = CMS_VerifySigData(strOutputFile, "", "", 0)
    oDebug.PPrint "CMS_VerifySigData returns " & nRet & " (expecting 0)"
    
End Function

Public Sub Show_Version()
    oDebug.PPrint vbCrLf & "Current CryptoSys PKI core DLL version is " & PKI_Version(0, 0)
End Sub