Attribute VB_Name = "basXmldsig2"

' $Id: basXmldsig2.bas $
' Ref: http://di-mgt.com.au/xmldsig2.html
' Copyright (C) 2012 DI Management Services Pty Ltd. All rights reserved.

Option Explicit

Public Sub Do_ComputeSigValFromFile()
    Dim strFileTBS As String
    Dim strKeyFile As String
    Dim strPassword As String
    Dim strSigVal As String
    
    strFileTBS = "enveloped-signedinfo.xml"
    strKeyFile = "AlicePrivRSASign_epk.txt"
    strPassword = "password"
    strSigVal = ComputeSigValFromFile(strFileTBS, strKeyFile, strPassword)
    Debug.Print strSigVal
End Sub

Public Function ComputeSigValFromFile(strFileTBS As String, strKeyFile As String, strPassword As String) As String
    Dim strPrivateKey As String
    Dim abSigInfo() As Byte
    Dim nsLen As Long
    Dim nkLen As Long
    Dim strDigHex As String
    Dim abBlock() As Byte
    Dim strSig64 As String
    Dim nRet As Long
    Dim nChars As Long
    Dim strXml As String
    
    ' Read in the private key from encrypted PKCS-8 file
    strPrivateKey = rsaReadPrivateKey(strKeyFile, strPassword)
    If Len(strPrivateKey) = 0 Then
        Debug.Print "ERROR: Cannot read private key"
        Exit Function
    End If
    Debug.Print "Key is " & RSA_KeyBits(strPrivateKey) & " bits"
    
    ' Display public key component as XML
    nChars = RSA_ToXMLString("", 0, strPrivateKey, PKI_XML_EXCLPRIVATE)
    Debug.Print "XML length = " & nChars
    strXml = String(nChars, " ")
    nChars = RSA_ToXMLString(strXml, Len(strXml), strPrivateKey, PKI_XML_EXCLPRIVATE)
    Debug.Print strXml
    
    ' Read in the input file to a byte array
    abSigInfo = ReadFileIntoBytes(strFileTBS)
    
    Debug.Print "M (ansi): '" & StrConv(abSigInfo, vbUnicode) & "'"
    Debug.Print "M (hex):  " & cnvHexStrFromBytes(abSigInfo)
    
    ' To sign: first encode the SignedInfo message, then "encrypt" with RSA
    ' Compute lengths
    nsLen = UBound(abSigInfo) - LBound(abSigInfo) + 1
    nkLen = RSA_KeyBytes(strPrivateKey)
    Debug.Print "Key is " & nkLen & " bytes long"
    Debug.Print "SigInfo is " & nsLen & " bytes long"
    ' Compute the SHA-1 digest just for info while we are passing...
    strDigHex = String(PKI_SHA1_CHARS, " ")
    Call HASH_HexFromBytes(strDigHex, Len(strDigHex), abSigInfo(0), nsLen, 0)
    Debug.Print "SHA1(SigInfo)=" & strDigHex
    
    ' Encode for signature
    ReDim abBlock(nkLen - 1)
    nRet = RSA_EncodeMsg(abBlock(0), nkLen, abSigInfo(0), nsLen, PKI_EMSIG_PKCSV1_5)
    Debug.Print "RSA_EncodeMsg returns " & nRet & " (expected 0)"
    Debug.Print "EM: " & cnvHexStrFromBytes(abBlock)
    
    ' Sign using RSA private key
    nRet = RSA_RawPrivate(abBlock(0), nkLen, strPrivateKey, 0)
    Debug.Print "SG: " & cnvHexStrFromBytes(abBlock)

    ' Convert the signature value to base64
    strSig64 = cnvB64StrFromBytes(abBlock)
    Debug.Print "SG: " & strSig64
    
    ComputeSigValFromFile = strSig64
    
End Function

Private Function ReadFileIntoBytes(sFilePath As String) As Variant
' Reads file (if it exists) into a byte array.
    Dim abIn() As Byte
    Dim hFile As Integer
    
    ' Check if file exists
    If Len(Dir(sFilePath)) = 0 Then
        Exit Function
    End If
    hFile = FreeFile
    Open sFilePath For Binary Access Read As #hFile
    abIn = InputB(LOF(hFile), #hFile)
    Close #hFile
    ReadFileIntoBytes = abIn
    
End Function