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