Attribute VB_Name = "Module1"
Option Explicit
Option Base 0

' *******************************************************************************************
' Copyright (c) 2010 DI Management Services Pty Limited. All rights reserved.
' This code was originally written by David Ireland.
' Provided as is with no warranties. Use at your own risk.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application, provided the copyright notice is left unchanged.
' *******************************************************************************************
' Requires CryptoSys PKI version 3.5 or greater <www.cryptosys.net/pki>
' Include basCrPKI in your VBA project.


Sub Button1_Click()
    Call Make_Signature
End Sub

Sub Button2_Click()
    Call Verify_Signature
End Sub

Sub Button3_Click()
    Call Clear_Verify
End Sub

Sub Sign_Button2_Click()
    Call Clear_Sign
End Sub

Sub Sign_Button3_Click()
    Call Copy_Data_From_Sign_To_Verify
End Sub

Public Function Verify_Signature()
    Dim strMessage As String
    Dim abData() As Byte
    Dim abBlock() As Byte
    Dim nBlockLen As Long
    Dim nKeyLen As Long
    Dim nMsgLen As Long
    Dim nLen As Long
    Dim nRet As Long
    Dim strCertFile As String
    Dim strPublicKey As String
    Dim strSignatureBase64 As String
    Dim abDigestFromSig() As Byte
    Dim strDigestFromSig As String
    Dim strDigest As String
    Dim strResult As String
    
    strResult = "ERROR"
    Call Clear_Verify
    
    ' Get input from named cell in spreadsheet
    strSignatureBase64 = Range("Signature_to_verify").Value & ""
    If Len(strSignatureBase64) = 0 Then
        MsgBox "Please enter the signature value", vbExclamation, "Missing Data"
        Range("Signature_to_verify").Activate
        GoTo Done
    End If
    
    ' Original string
    strMessage = Range("Message_to_verify_against").Value & ""
    If Len(strMessage) = 0 Then
        MsgBox "Require original string", vbExclamation, "Missing Data"
        Range("Message_to_verify_against").Activate
        GoTo Done
    End If
    
    ' The certificate  filename
    strCertFile = Range("Certificate_file").Value & ""
    If Len(strCertFile) = 0 Then
        MsgBox "Please enter the filename of your public key certificate", vbExclamation, "Missing Data"
        Range("Certificate_file").Activate
        GoTo Done
    End If
    
    ' Fix filename to CWD
    strCertFile = ActiveWorkbook.Path & "\" & strCertFile
    
    ' Read in public key from certificate to an "internal" key string
    nLen = RSA_GetPublicKeyFromCert("", 0, strCertFile, 0)
    If nLen <= 0 Then
        MsgBox "Cannot read certificate file: " & pkiErrorLookup(nLen)
        GoTo Done
    End If
    ' Pre-dimension string to receive key details
    strPublicKey = String(nLen, " ")
    ' Now read it
    nLen = RSA_GetPublicKeyFromCert(strPublicKey, Len(strPublicKey), strCertFile, 0)
    
    ' DEBUGGING...
    ''Range("Input_signature_in_hex").Value = strPublicKey
    
    ' Block length is same size as the key in bytes
    nKeyLen = RSA_KeyBytes(strPublicKey)
    If nKeyLen <= 0 Then
        MsgBox "Error with the public key: " & pkiErrorLookup(nKeyLen)
        GoTo Done
    End If
    ' Display key size in bits
    Range("Key_size_in_bits").Value = RSA_KeyBits(strPublicKey)
    
    ' Decode signature block from base64
    abBlock = cnvBytesFromB64Str(strSignatureBase64)
    nBlockLen = UBound(abBlock) + 1
    ' Display it
    Range("Input_signature_in_hex").Value = cnvHexStrFromBytes(abBlock)
    
    ' Check size matches public key size
    If nBlockLen <> nKeyLen Then
        MsgBox "ERROR: signature size does not match public key length", vbCritical
        GoTo Done
    End If
    
    ' Now "decrypt" the signature block using the RSA public key
    nRet = RSA_RawPublic(abBlock(0), nBlockLen, strPublicKey, 0)
    ' Display it
    Range("Decrypted_signature_block").Value = cnvHexStrFromBytes(abBlock)
    
    ' Extract the message digest from this block (it should be the same size as an SHA-1 digest in BYTES)
    nLen = PKI_SHA1_BYTES
    ReDim abDigestFromSig(nLen - 1)
    nLen = RSA_DecodeMsg(abDigestFromSig(0), nLen, abBlock(0), nBlockLen, PKI_EMSIG_PKCSV1_5)
    If nLen < 0 Then
        strResult = "Invalid signature"
        GoTo Done
    End If
    
    ' Convert this to hex
    strDigestFromSig = UCase(cnvHexStrFromBytes(abDigestFromSig))
    ' Display it
    Range("Digest_from_signature").Value = strDigestFromSig
    
    ' Now compute the SHA-1 digest of the original message - it must match
    strDigest = String(PKI_SHA1_CHARS, " ")
    nRet = HASH_HexFromString(strDigest, Len(strDigest), strMessage, Len(strMessage), PKI_HASH_SHA1)
    strDigest = UCase(strDigest)
    ' Display it
    Range("Message_digest").Value = strDigest
    
    ' Compare the two digests
    If strDigest = strDigestFromSig Then
        strResult = "OK"
    Else
        strResult = "Invalid signature"
    End If
   
Done:
    ' Finally, display the result - either "OK" or "Invalid signature"
    Range("Result").Value = strResult
    Verify_Signature = strResult
    
    Exit Function
HandleError:
    MsgBox "An error has occurred: " & Err.Number & ": " & Err.Description
    Resume Done
End Function

Public Sub Clear_Verify()
    ' Clear all working fields on the "Verify" sheet
    Range("Result").Value = ""
    Range("Verify!Key_size_in_bits").Value = ""
    Range("Input_signature_in_hex").Value = ""
    Range("Decrypted_signature_block").Value = ""
    Range("Digest_from_signature").Value = ""
    Range("Message_digest").Value = ""
    
End Sub

Public Sub Clear_Sign()
    ' Clear all working fields on the "Sign" sheet
    Range("Key_size_in_bits").Value = ""
    Range("Signature_base64").Value = ""
    Range("Input_block_to_signature").Value = ""
    Range("Signature_in_hex").Value = ""
    
End Sub

Public Sub Copy_Data_From_Sign_To_Verify()
    Call Clear_Verify
    Range("Signature_to_verify").Value = Range("Signature_base64").Value
    Range("Message_to_verify_against").Value = Range("Input_text_to_sign").Value
    Sheets("Verify").Activate
    Range("Signature_to_verify").Activate

    
End Sub

Public Function Make_Signature() As String
On Error GoTo HandleError
    Dim strMessage As String
    Dim abData() As Byte
    Dim abBlock() As Byte
    Dim nBlockLen As Long
    Dim nMsgLen As Long
    Dim nLen As Long
    Dim nRet As Long
    Dim strKeyFile As String
    Dim strPassword As String
    Dim strPrivateKey As String
    Dim strSignatureBase64 As String
    
    Call Clear_Sign
    
    ' Get input from named cell in spreadsheet
    strMessage = Range("Input_text_to_sign").Value & ""
    If Len(strMessage) = 0 Then
        MsgBox "No input text!", vbExclamation, "Missing Data"
        Range("Input_text_to_sign").Activate
        GoTo Done
    End If
    ''Range("Input_block_to_signature").Value = strMessage
    
    ' The private key filename
    strKeyFile = Range("Private_key_file").Value & ""
    If Len(strKeyFile) = 0 Then
        MsgBox "Please enter the filename of your private key", vbExclamation, "Missing Data"
        Range("Private_key_file").Activate
        GoTo Done
    End If
    
    ' and the password
    strPassword = Range("Password").Value & ""
    If Len(strPassword) = 0 Then
        MsgBox "Please enter the password", vbExclamation, "Missing Data"
        Range("Password").Activate
        GoTo Done
    End If
    
    ' Fix filename to CWD
    strKeyFile = ActiveWorkbook.Path & "\" & strKeyFile
    
    ' Read in keyfile to an "internal" key string
    nLen = RSA_ReadEncPrivateKey("", 0, strKeyFile, strPassword, 0)
    If nLen <= 0 Then
        MsgBox "Cannot read private file: " & pkiErrorLookup(nLen)
        GoTo Done
    End If
    ' Pre-dimension string to receive key details
    strPrivateKey = String(nLen, " ")
    ' Now read it
    nLen = RSA_ReadEncPrivateKey(strPrivateKey, Len(strPrivateKey), strKeyFile, strPassword, 0)
    
    '''Range("Signature_in_hex").Value = strPrivateKey
    
    ' Block length is same size as the key in bytes
    nBlockLen = RSA_KeyBytes(strPrivateKey)
    If nBlockLen <= 0 Then
        MsgBox "Error with the private key: " & pkiErrorLookup(nBlockLen)
        GoTo Done
    End If
    ' Display key size in bits
    Range("Key_size_in_bits").Value = RSA_KeyBits(strPrivateKey)
    
    ' Convert message string to array of bytes
    abData = StrConv(strMessage, vbFromUnicode)
    nMsgLen = UBound(abData) + 1
    ' Encode (pad) data for RSA signature block using default SHA-1
    ReDim abBlock(nBlockLen - 1)
    nRet = RSA_EncodeMsg(abBlock(0), nBlockLen, abData(0), nMsgLen, PKI_EMSIG_PKCSV1_5)
    ' Display block in hex
    Range("Input_block_to_signature").Value = cnvHexStrFromBytes(abBlock)
    
    ' Now we sign it using RSA private key
    nRet = RSA_RawPrivate(abBlock(0), nBlockLen, strPrivateKey, 0)
    ' Now we display it in both hex and base64 encoded forms
    Range("Signature_in_hex").Value = cnvHexStrFromBytes(abBlock)
    Range("Signature_base64").Value = cnvB64StrFromBytes(abBlock)
    
    ' Return base64-encoded signature value
    strSignatureBase64 = cnvB64StrFromBytes(abBlock)
    Make_Signature = strSignatureBase64
    
Done:
    ' TODO: wipe key and password data here...
    Exit Function
HandleError:
    MsgBox "An error has occurred: " & Err.Number & ": " & Err.Description
    Resume Done
End Function