Option Explicit 
Option Compare Text

' This shows how data in a file can be signed and encrypted in S/MIME format
' and then decrypted and verified using CryptoSys PKI functions.
' Alice is the sender. Bob is the recipient.

' Where we keep our RSA key files and other data
' IMPORTANT - change this to suit your system
Private Const scTESTDIR As String = "C:\Test\"

' A couple of useful error handling functions
Public Function ErrorDesc(nErrCode As Long) As String
    Dim nLen As Long
    Dim strErrMsg As String * 128
    
    nLen = PKI_ErrorLookup(strErrMsg, Len(strErrMsg), nErrCode)
    ErrorDesc = Left(strErrMsg, nLen)
End Function

Public Sub ShowError(strFunctionName As String, nErrCode As Long)
    MsgBox strFunctionName & " ERROR: " & nErrCode & " (" & ErrorDesc(nErrCode) & ")" & vbCrLf & pkiGetLastError, vbCritical
End Sub

Public Function SignAndEncrypt()
' The sending party (Alice) has the following files:-
' AliceRSASignByCarl.cer - her own X.509 certificate
' AlicePrivRSASign.epk - her encrypted private key (password="password")
' BobRSASignByCarl.cer - the recipient's (Bob) X.509 certificate
' excontent.txt - the plaintext data to be signed and encrypted

    Dim strInputFile As String
    Dim strMyCertFile As String
    Dim strPrivateKeyFile As String
    Dim strTheirCertFile As String
    Dim strPassword As String
    Dim strPrivateKey64 As String
    Dim strInterFile As String
    Dim strOutputFile As String
    Dim lRet As Long
    
    ' Set up to find our files
    strInputFile = scTESTDIR & "excontent.txt"
    strMyCertFile = scTESTDIR & "AliceRSASignByCarl.cer"
    strTheirCertFile = scTESTDIR & "BobRSASignByCarl.cer"
    strPrivateKeyFile = scTESTDIR & "AlicePrivRSASign.epk"
    strPassword = "password"
    
    ' 1. SIGNING.
    ' To sign the data, Alice needs her private key and her X.509 certificate
    
    ' Read in the private key as a base64 string
    ' NB There is a deliberate half-second pause in this function
    strPrivateKey64 = rsaReadPrivateKey(strPrivateKeyFile, strPassword)
    
    ' Check for error
    If Len(strPrivateKey64) = 0 Then
        MsgBox "Unable to read private key file", vbCritical
        Exit Function
    End If
    Debug.Print "Read private key: " & RSA_KeyBits(strPrivateKey64) & " bits."
    
    ' Sign the data using the MD5 algorithm, creating an intermediate CMS object file
    strInterFile = scTESTDIR & "ex_signed.dat"
    lRet = CMS_MakeSigData(strInterFile, strInputFile, strMyCertFile, strPrivateKey64, PKI_HASH_MD5)
    If lRet <> 0 Then
        ShowError "CMS_MakeSigData", lRet
        Exit Function
    End If
    Debug.Print "Created signed file " & strInterFile
    
    ' 2. ENCRYPTION.
    ' To encrypt the data, Alice needs Bob's certificate, which is publicly available.
    strOutputFile = scTESTDIR & "ex_encsigned.dat"
    ' Encrypt for Bob (and for Alice, too, while we're at it)
    lRet = CMS_MakeEnvData(strOutputFile, strInterFile, strTheirCertFile & ";" & strMyCertFile, "", 0, 0)
    ' Note that this function returns the positive number of successful recipients if successful
    If lRet <= 0 Then
        ShowError "CMS_MakeEnvData", lRet
        Exit Function
    End If
    Debug.Print "Created encrypted and signed file '" & strOutputFile & "' for " & lRet & " recipients."
    
    ' Clean up
    ' NB We should have done this when handling errors above, too.
    Call WIPE_String(strPassword, Len(strPassword))
    Call WIPE_String(strPrivateKey64, Len(strPrivateKey64))

End Function

Public Function DecryptAndVerify()
' The receiving party (Bob) has the following files:-
' AliceRSASignByCarl.cer - the sender's X.509 certificate
' BobRSASignByCarl.cer - the recipient's (Bob) X.509 certificate
' BobPrivRSAEncrypt.epk - his own encrypted private key (password="password")
' ex_encsigned.dat - the signed and encrypted data file he's received

    Dim strInputFile As String
    Dim strMyCertFile As String
    Dim strPrivateKeyFile As String
    Dim strTheirCertFile As String
    Dim strPassword As String
    Dim strPrivateKey64 As String
    Dim strInterFile As String
    Dim strOutputFile As String
    Dim lRet As Long
    Dim strData As String
    
    ' Set up to find our files
    strInputFile = scTESTDIR & "ex_encsigned.dat"
    strTheirCertFile = scTESTDIR & "AliceRSASignByCarl.cer"
    strPrivateKeyFile = scTESTDIR & "BobPrivRSAEncrypt.epk"
    strPassword = "password"
    
    ' 1. DECRYPTION
    ' To decrypt, Bob needs his own private key
    
    ' First, read in the private key as a base64 string
    ' NB There is a deliberate half-second pause in this function
    strPrivateKey64 = rsaReadPrivateKey(strPrivateKeyFile, strPassword)
    
    ' Check for error
    If Len(strPrivateKey64) = 0 Then
        MsgBox "Unable to read private key file", vbCritical
        Exit Function
    End If
    Debug.Print "Read private key: " & RSA_KeyBits(strPrivateKey64) & " bits."
    
    ' Decrypt to an intermediate file
    strInterFile = scTESTDIR & "ex_decrypted.dat"
    ' Note that as there are more than one recipient in this file, Bob needs to
    ' specify which recipient he is by passing his cert name.
    ' (if he was the only one, he could omit the strMyCertFile parameter and pass "" instead)
    lRet = CMS_ReadEnvData(strInterFile, strInputFile, strMyCertFile, strPrivateKey64, 0)
    If lRet <> 0 Then
        ShowError "CMS_ReadEnvData", lRet
        Exit Function
    End If
    Debug.Print "Created decrypted file " & strInterFile
    
    ' Clean up now we are done with secret info
    Call WIPE_String(strPassword, Len(strPassword))
    Call WIPE_String(strPrivateKey64, Len(strPrivateKey64))
    
    ' 2. EXTRACTION
    ' To extract the actual data that has been signed Bob just needs the signed-data file
    ' (Note that if the decryption had failed in the previous step, this function will fail, too)
    strOutputFile = scTESTDIR & "ex_final.txt"
    lRet = CMS_ReadSigData(strOutputFile, strInterFile, 0)
    ' NB Function returns positive number of bytes in output if successful, or a -ve error code
    If lRet < 0 Then
        ShowError "CMS_ReadSigData", lRet
        Exit Function
    End If
    Debug.Print "Extracted signed plaintext into file " & strInterFile
    
    ' 3. VERIFICATION
    ' For Bob to verify that he really has the same data that Alice signed, he needs to
    ' extract the hash digest from the signed-data file and then compare this to
    ' the message digest hash of the extracted data
    Dim strDigestAsSigned As String
    Dim strDigestOfData As String
    Dim nAlgorithm As Long
    Dim nChars As Long
    
    ' 3a. Extract the message digest from the signed-data file
    ' pre-dimensioning the output string first
    strDigestAsSigned = String(PKI_MAX_HASH_LEN, " ")
    lRet = CMS_GetSigDataDigest(strDigestAsSigned, Len(strDigestAsSigned), strInterFile, strMyCertFile, 0)
    ' NB This function returns the hash digest algorithm as a non-negative number or a -ve error code
    ' if it fails, including -22 if the signature is not valid.
    If lRet < 0 Then
        ShowError "CMS_GetSigDataDigest", lRet
        Exit Function
    End If
    strDigestAsSigned = Trim(strDigestAsSigned)
    Debug.Print "Digest as signed = " & strDigestAsSigned & ". Algorithm code = " & lRet
    ' Remember the algorithm code for the next step
    nAlgorithm = lRet
    
    ' 3b. Compute the message digest of the actual data we extracted in step 2
    ' using the same algorithm we just found out in step 3a
    ' NB don't forget to pre-dimension
    strDigestOfData = String(PKI_MAX_HASH_LEN, " ")
    lRet = HASH_HexFromFile(strDigestOfData, Len(strDigestOfData), strOutputFile, nAlgorithm)
    ' This function returns the +ve number of chars in the digest, or a -ve error code
    If lRet < 0 Then
        ShowError "HASH_HexFromFile", lRet
        Exit Function
    End If
    ' Remember the number of chars we got
    nChars = lRet
    
    ' 3c. Compare the two digests to verify the data we extracted is as signed by Alice
    ' Make sure both strings are the same length
    strDigestAsSigned = Left(strDigestAsSigned, nChars)
    strDigestOfData = Left(strDigestOfData, nChars)
    Debug.Print "Digest of data = " & strDigestOfData
    
    If StrComp(strDigestAsSigned, strDigestOfData, vbTextCompare) <> 0 Then
        MsgBox "VERIFICATION FAILED: Message Digests do not match.", vbCritical
    Else
        Debug.Print "Digests are equal. Verification is complete."
    End If
    
    ' 3d. As an extra step, to show off an alternative method,
    ' we read in the original data to a string,
    ' instead of using a file as we did in step 3a.
    nChars = CMS_ReadSigDataToString("", 0, strInterFile, 0)
    If nChars > 0 Then
        strData = String(nChars, " ")
    Else
        ShowError "CMS_ReadSigDataToString", nChars
        Exit Function
    End If
    nChars = CMS_ReadSigDataToString(strData, Len(strData), strInterFile, 0)
    Debug.Print "Data=[" & strData & "]"
    
    ' And compute the message digest of this string
    strDigestOfData = String(PKI_MAX_HASH_LEN, " ")
    lRet = HASH_HexFromString(strDigestOfData, Len(strDigestOfData), strData, Len(strData), nAlgorithm)
    If lRet > 0 Then
        Debug.Print "Digest of string = " & strDigestOfData
    End If
    
End Function