Attribute VB_Name = "PortugalTax2"
Option Explicit
Option Base 0

' $Id: PortugalTax2.bas $
' $Date: 2010-11-25 09:13Z $
' $Revision: 2.0 $
' $Author: dai $

' *************************** COPYRIGHT NOTICE ******************************
' This code was originally written by David Ireland and is copyright
' (C) 2010 DI Management Services Pty Ltd <www.di-mgt.com.au>.
' Provided "as is". No warranties. Use at your own risk. You must make your
' own assessment of its accuracy and suitability for your own purposes.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application, provided this copyright notice
' is left unchanged.
' ************************ END OF COPYRIGHT NOTICE **************************

' This module uses functions from the CryptoSys (tm) PKI Toolkit available from
' <www.cryptosys.net/pki/>.
' Include the module `basCrPKI` in your project.

' NOTES:
' (1) The key files in these tests are expected to exist in the current working directory.
' (2) The word "signature" or "signature value" == the <Hash> field of the specification.

' REFERENCES:
' [ESPECIF-2010] "Especificação das Regras Técnicas para Certificação de Software
' Portaria n.º 363/2010, de 23 de Junho", Direcção Geral dos Impostos (DGCI), Especificacao_regras_tecnicas_Certificacao_Softwar.pdf
' <http://info.portaldasfinancas.gov.pt/NR/rdonlyres/BF3D4A62-3243-404F-8F94-DCB2B19547C3/44379/Especificacao_regras_tecnicas_Certificacao_Softwar.pdf>
' (accessed 7 August 2010).
'
' [ADIT-2010] "- 1º Aditamento - Especificação das Regras Técnicas para Certificação de Software
' Portaria n.º 363/2010, de 23 de Junho", Direcção Geral dos Impostos (DGCI), 1_Aditamento_Especificaca_regras_tecnicas.pdf
' <http://info.portaldasfinancas.gov.pt/NR/rdonlyres/84B18C77-577B-4581-A846-2DB0201B0FB4/0/1_Aditamento_Especificaca_regras_tecnicas.pdf>
' (accessed 21 November 2010).


' *******************
' GENERIC FUNCTIONS *
' *******************

Public Function rsaCreateSignatureInBase64(strMessage As String, strKeyFile As String, Optional ShowDebug As Boolean = False) As String
' $GENERIC-FUNCTION$
' INPUT:  Message string to be signed; filename of private RSA key file (unencrypted OpenSSL format)
' OUTPUT: Signature in base64 format
    Dim strPrivateKey As String
    Dim nRet As Long
    Dim abMessage() As Byte
    Dim nMsgLen As Long
    Dim abBlock() As Byte
    Dim nBlkLen As Long
    Dim strSigBase64 As String
    
    ' 1. Convert message into unambigous array of bytes and compute length
    abMessage = StrConv(strMessage, vbFromUnicode)
    nMsgLen = UBound(abMessage) + 1     ' NB Arrays start at zero
    If ShowDebug Then Debug.Print "Message length = " & nMsgLen & " bytes."
    
    ' 1a. While we're here, compute the digest of the input. (We don't need it but it's a check for later)
    Dim strDigest As String
    strDigest = String(PKI_SHA1_CHARS, " ")
    nRet = HASH_HexFromBytes(strDigest, Len(strDigest), abMessage(0), nMsgLen, PKI_HASH_SHA1)
    If ShowDebug Then Debug.Print "DIGEST=" & strDigest
    
    ' 2. Read the private key file into our internal string format
    ' (Note that strPrivateKey is a one-off, ephemeral, internal string we made when reading the key file.
    ' You can't save it to use again.)
    strPrivateKey = rsaReadPrivateKeyInfo(strKeyFile)
    If Len(strPrivateKey) <= 0 Then
        rsaCreateSignatureInBase64 = "**ERROR: cannot read private key file"
        Exit Function
    End If
    If ShowDebug Then Debug.Print "Private key size is " & RSA_KeyBits(strPrivateKey) & " bits."
    
    ' 3. Encode (i.e. digest and pad) the message into format required for PKCS#1v1.5 signature
    ' Required block length is key size in bytes
    nBlkLen = RSA_KeyBytes(strPrivateKey)
    If ShowDebug Then Debug.Print "Key/block size is " & nBlkLen & " bytes."
    ' Pre-dimension the block (NB zero-based array in VB6)
    ReDim abBlock(nBlkLen - 1)
    nRet = RSA_EncodeMsg(abBlock(0), nBlkLen, abMessage(0), nMsgLen, PKI_EMSIG_PKCSV1_5 + PKI_HASH_SHA1)
    If ShowDebug Then Debug.Print "RSA_EncodeMsg returns " & nRet & " (0 => success)"
    ' Show the encoded block in hex format (should be 0001FFFF...ending with the 20-byte digest)
    If ShowDebug Then Debug.Print cnvHexStrFromBytes(abBlock)
    
    ' 4. Create the signature block using the private key
    nRet = RSA_RawPrivate(abBlock(0), nBlkLen, strPrivateKey, 0)
    If ShowDebug Then Debug.Print "RSA_RawPrivate returns " & nRet & " (0 => success)"
    ' Show the signature block in hex format
    If ShowDebug Then Debug.Print cnvHexStrFromBytes(abBlock)
    
    ' 5. Convert to base64 format
    strSigBase64 = cnvB64StrFromBytes(abBlock)
    If ShowDebug Then Debug.Print strSigBase64
    
    ' Return base64 signature
    rsaCreateSignatureInBase64 = strSigBase64
    
End Function

Public Function rsaVerifySignature(strSigBase64 As String, strPublicKeyFileOrCert As String, strTextToSign As String, _
    Optional ShowDebug As Boolean = False) As String
' $GENERIC-FUNCTION$
' INPUT:  Signature value in base64 format (the <Hash> field);
'         filename of RSA public key file or X.509 certificate containing the same public key;
'         text that was signed.
' OUTPUT: "OK" if signature is valid or error message beginning "**ERROR" if not.

    Dim strPublicKey As String
    Dim nRet As Long
    Dim nMsgLen As Long
    Dim abBlock() As Byte
    Dim nBlkLen As Long
    Dim abDigest() As Byte
    Dim nDigLen As Long
    Dim strDigest As String
    Dim strDigest1 As String
    
    ' 1. Read the public key file into our internal string format
    strPublicKey = rsaReadPublicKey(strPublicKeyFileOrCert)
    If Len(strPublicKey) <= 0 Then
        ' Was not a public key file, so try reading an X.509 certificate instead
        strPublicKey = rsaGetPublicKeyFromCert(strPublicKeyFileOrCert)
        If Len(strPublicKey) <= 0 Then
            rsaVerifySignature = "**ERROR: cannot read public key file"
            Exit Function
        End If
    End If
    If ShowDebug Then Debug.Print "Public key size is " & RSA_KeyBits(strPublicKey) & " bits."
    
    ' 2. Convert base64 signature to byte array
    abBlock = cnvBytesFromB64Str(strSigBase64)
    nBlkLen = UBound(abBlock) + 1
    If ShowDebug Then Debug.Print "Signature block length = " & nBlkLen & " bytes"
    If ShowDebug Then Debug.Print cnvHexStrFromBytes(abBlock)
   
    ' 3. Decrypt the signature block using the RSA public key
    ' (Note that strPublicKey is a one-off, ephemeral, internal string we made when reading the key file.
    ' You can't save it to use again.)
    nRet = RSA_RawPublic(abBlock(0), nBlkLen, strPublicKey, 0)
    If ShowDebug Then Debug.Print "RSA_RawPublic returns " & nRet & " (0 => success)"
    ' Show the decrypted signature block in hex format
    If ShowDebug Then Debug.Print cnvHexStrFromBytes(abBlock)
    
    ' 4. Extract the message digest from the block (presumed SHA-1)
    nDigLen = RSA_DecodeMsg(0, 0, abBlock(0), nBlkLen, PKI_EMSIG_PKCSV1_5)
    If nDigLen < 0 Then
        rsaVerifySignature = "**ERROR: invalid signature"
        Exit Function
    End If
    If ShowDebug Then Debug.Print "Message digest is " & nDigLen & " bytes long"
    ReDim abDigest(nDigLen - 1)
    nDigLen = RSA_DecodeMsg(abDigest(0), nDigLen, abBlock(0), nBlkLen, PKI_EMSIG_PKCSV1_5)
    strDigest = cnvHexStrFromBytes(abDigest)
    If ShowDebug Then Debug.Print "EXTRACTED DIGEST=" & strDigest
    
    ' 5. Compute the SHA-1 message digest of the text that was signed
    strDigest1 = String(PKI_SHA1_CHARS, " ")
    nRet = HASH_HexFromString(strDigest1, Len(strDigest1), strTextToSign, Len(strTextToSign), PKI_HASH_SHA1)
    If ShowDebug Then Debug.Print "COMPUTED DIGEST =" & strDigest1
    
    ' 6. Compare these two digest values and return OK only if they match
    If UCase(strDigest) = UCase(strDigest1) Then
        rsaVerifySignature = "OK"
    Else
        rsaVerifySignature = "**ERROR: invalid signature"
    End If

End Function

Public Function hashHexFromString_SHA1(strMessage As String) As String
' $GENERIC-FUNCTION$
' INPUT:  Message to be hashed in a string of ANSI characters
' OUTPUT: SHA-1 digest in hex-encoded format
    Dim nRet As Long
    Dim strDigest As String
    
    strDigest = String(PKI_SHA1_CHARS, " ")
    nRet = HASH_HexFromString(strDigest, Len(strDigest), strMessage, Len(strMessage), PKI_HASH_SHA1)
    hashHexFromString_SHA1 = strDigest

End Function

Public Function rsaGetDigestFromBase64Signature(strSigBase64 As String, strKeyFile As String, Optional ShowDebug As Boolean = False) As String
' $GENERIC-FUNCTION$
' INPUT:  Signature value in base64 format; filename of public key file.
' OUTPUT: SHA-1 digest of signed message in hex-encoded format
    Dim strPublicKey As String
    Dim nRet As Long
    Dim nMsgLen As Long
    Dim abBlock() As Byte
    Dim nBlkLen As Long
    Dim abDigest() As Byte
    Dim nDigLen As Long
    Dim strDigest As String
    
    ' 1. Convert to byte array
    abBlock = cnvBytesFromB64Str(strSigBase64)
    nBlkLen = UBound(abBlock) + 1
    If ShowDebug Then Debug.Print "Signature block length = " & nBlkLen & " bytes"
    If ShowDebug Then Debug.Print cnvHexStrFromBytes(abBlock)
   
    ' 2. Read the public key file into our internal string format
    strPublicKey = rsaReadPublicKey(strKeyFile)
    If Len(strPublicKey) <= 0 Then
        rsaGetDigestFromBase64Signature = "**ERROR: cannot read public key file"
        Exit Function
    End If
    If ShowDebug Then Debug.Print "Public key size is " & RSA_KeyBits(strPublicKey) & " bits."
    
    ' 3. Decrypt the signature block using the public key
    nRet = RSA_RawPublic(abBlock(0), nBlkLen, strPublicKey, 0)
    If ShowDebug Then Debug.Print "RSA_RawPublic returns " & nRet & " (0 => success)"
    ' Show the decrypted signature block in hex format
    If ShowDebug Then Debug.Print cnvHexStrFromBytes(abBlock)
    
    ' 4. Extract the SHA-1 message digest from the block
    nDigLen = RSA_DecodeMsg(0, 0, abBlock(0), nBlkLen, PKI_EMSIG_PKCSV1_5)
    If nDigLen < 0 Then
        rsaGetDigestFromBase64Signature = "**ERROR: Decryption Error"
        Exit Function
    End If
    If ShowDebug Then Debug.Print "Message digest is " & nDigLen & " bytes long"
    ReDim abDigest(nDigLen - 1)
    nDigLen = RSA_DecodeMsg(abDigest(0), nDigLen, abBlock(0), nBlkLen, PKI_EMSIG_PKCSV1_5)
    strDigest = cnvHexStrFromBytes(abDigest)
    If ShowDebug Then Debug.Print "DIGEST=" & strDigest
    
    ' Return extracted digest in hex form
    rsaGetDigestFromBase64Signature = strDigest

End Function

' *******
' TESTS *
' *******

Public Sub Pt_CreateSignature_Especificacao()
' Compute the correct signature values for the examples given in [ESPECIF-2010]
    Dim strMessage As String
    Dim strKeyFile As String
    Dim strSigBase64 As String
    
    ' Private key file: sample provided by DGCI
    strKeyFile = "Chave_Privada.txt"
    
    ' Registo 1
    ' Message string to be signed as per [REF] specifications
    ' (not including quotes; no intermediate spaces or CR-LF chars)
    strMessage = "2010-05-18;2010-05-18T11:22:19;FAC 001/14;3.12;"
    
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "1: " & strSigBase64
    ' Original value = "Am1K5+CP4LDNVDZYvcL...UnuJrca+7emgb/kpU="
    ' Correct value = "OpE9IFpK5cJO8SwC5BUy3XTCkjVK5JsjHo3TvWjM9D09aw9wabH+sGNOs7hx4iEoOP9UY6DGsR6PgIkAZSTYInhbgs2x9sxWkr417aCKoSGY4awDIVB9aUlQ91SseH3Hk5S24PfjXFDn44acWhQL4INp9Re+dC51YNC7MrpAmP4="
    
    ' Registo 2
    strMessage = "2010-05-18;2010-05-18T15:43:25;FAC 001/15;25.62;" & _
        "Am1K5+CP4LDNVDZYvcLYGpnu8/1b+WWkzgoe8sbZhvk6QFzFvNN77Zsq+cHNm52jCVS" & _
        "EDgWLGHgPS1wcT8ZG7w6KgVq+2/VgOU+xKNt0lcC3gouyarZvcZpZclIReDgLh6m3nv8D" & _
        "YYHKAOQc+eCi/BQ4LqUnuJrca+7emgb/kpU="
    
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "2: " & strSigBase64
    ' Original value = "Jh7/rmIILVwbrPLTdk...RG8JS1Uos78="
    ' Correct value = "hsR2TYJtl0mad+zVAhGxNLxs6matD+T8Y8IpEo12I3szSohdwwWVOfPclnu6D23pZ0w8g/Eh0TOMzYNsdkkUJpM68/nKH2d8ehI8HT85NUyLgrGhC8msXHK+ASCCOU0RN4mr04249IG+MuOAlnW8EcMJNZA+lTf94MbpJNqRYUw="
    
End Sub

Public Sub Pt_CreateSignature_SAFT_IDEMO()
' Reproduce the signatures (<Hash>) values in SAFT_IDEMO599999999.XML
    Dim strMessage As String
    Dim strKeyFile As String
    Dim strSigBase64 As String
    
    ' Sample XML data file and private key file provided by DGCI at:
    ' <http://info.portaldasfinancas.gov.pt/pt/apoio_contribuinte/certificacaosoftware.htm>
    ' <http://info.portaldasfinancas.gov.pt/NR/rdonlyres/371795DE-D83B-4B0E-B673-010C0F523EFB/0/SAFT_IDEMO599999999.XML>
    
    ' Private key file:
    ' <http://info.portaldasfinancas.gov.pt/NR/rdonlyres/70FDBA7F-1C48-496C-B9C3-4F45B4FAA55F/0/Chave_Privada.txt>
    strKeyFile = "Chave_Privada.txt"
    
    ' Message string from 1st record in SAFT_IDEMO599999999.XML (starting at line 9492)
    ' This is the first record of the series, so the "Hash" field is empty
    strMessage = "2008-03-10;2008-03-10T15:58:00;FT 1/1;28.07;"
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "FT 1/1: " & strSigBase64
    ' Expected signature = "F8952fjEClltx2tF9m6/...jsablpR6A4="
    
    ' Record 2: carry forward the Hash field from record 1
    strMessage = "2008-09-16;2008-09-16T15:58:00;FT 1/2;235.15;" & _
        "F8952fjEClltx2tF9m6/QTFynFjSuiboMslNZ1ag9oR5iIivgYYa0cNa0wJeWXlsf8QQVHUol303hp7XmIy5/kFOiV0Cv8QH6SF0Q5zNsDtpeFh2ZJ256y0DkJMSQqCq3oSka+9zIXXRkXgEsSv6VScCYv8VTlIcGjsablpR6A4="
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "FT 1/2: " & strSigBase64
    ' Expected signature = "wh0uUgI/fLTt9Kpb/hFw.../bU651c3va0="

    ' Record 3: carry forward the Hash field from record 2
    strMessage = "2008-09-16;2008-09-16T15:58:00;FT 1/3;679.61;" & _
        "wh0uUgI/fLTt9Kpb/hFwN6VIkjWZWI8R2TxtHUMyRL0a7hyQLIvoxuqGzKfzUfvAV3E1gxpKZtai5qli6Nx7unqzC4vIoc6rtb3ObuxifXiBAUD95BMh31T73O6cgcwhGR0YhiV/E6jfCbihJL2B/2s+/qsaL7OY/bU651c3va0="
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "FT 1/3: " & strSigBase64
    ' Expected signature = "iVYbEDuefMedP5DHBfl+...Z4+0oX3qdxY="
    
    ' ...etc, etc, ...
    Debug.Print "..."
    
    ' Record 6: carry forward the Hash field from record 5
    strMessage = "2008-10-21;2008-10-21T15:32:00;FT 1/6;3600.00;" & _
        "nv2NKxZ5c/1aC/D6RgCL0Z1EmvkELlxQ0qUQwu/5C+5fvDwb5+nigoN8G5NZjebQTJefCK3nT7DxYjfuTLaVwkDHsHDqW+WzNJ7r2VlGeeBV/TKpgYwy45Vb9dlpx3pwDftlfV44yLJN/uO6RIQnTU4o9+r0DtoPibhm8zEAaA4="
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "FT 1/6: " & strSigBase64
    ' Expected signature = "V5HNew6rKFxmSeNTSmp5...AqTsAdmi9WU="
    
    
    ' Record NC 1/1: We start a new series, so leave hash field empty
    strMessage = "2008-09-16;2008-09-16T15:58:00;NC 1/1;235.15;" & _
        ""
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "NC 1/1: " & strSigBase64
    ' Expected signature = "jTCuqNUzz+QDJiHeOGwk...DpQ3kO770ko="
    
    ' Record NC 1/2: carry forward the Hash field from record 1
    strMessage = "2008-09-16;2008-09-16T15:58:00;NC 1/2;2261.34;" & _
        "jTCuqNUzz+QDJiHeOGwkJzBoJwqNOLRMs0ISI7TXddv5RrH8KmKtaMgzaZxWY9QO4U5aoasqHRieqof+7oXq0fALKcROyVxU/PQRsh7eKani46ENkrkQNXREjAdz1nvoCSAKphd21nfMJupWlYTAJV2H0A7I+MGcDpQ3kO770ko="
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    Debug.Print "NC 1/2: " & strSigBase64
    ' Expected signature = "YIt8KKn+0m9HpK2BpsnY...vfxhM7re2SU="
    
End Sub

Public Sub Pt_VerifySignature()
    Dim strMessage As String
    Dim strKeyFile As String
    Dim strSigBase64 As String
    Dim strStatus As String
    
    ' Public key file:
    ' <http://info.portaldasfinancas.gov.pt/NR/rdonlyres/547D8EFD-4B88-4072-8CD8-17DF08FE847A/0/Chave_Publica.txt>
    strKeyFile = "Chave_Publica.txt"
    
    ' Message string and "Hash" from 1st record in SAFT_IDEMO599999999.XML (starting at line 9492)
    strMessage = "2008-03-10;2008-03-10T15:58:00;FT 1/1;28.07;"
    strSigBase64 = "F8952fjEClltx2tF9m6/QTFynFjSuiboMslNZ1ag9oR5iIivgYYa0cNa0wJeWXlsf8QQVHUol303hp7XmIy5/kFOiV0Cv8QH6SF0Q5zNsDtpeFh2ZJ256y0DkJMSQqCq3oSka+9zIXXRkXgEsSv6VScCYv8VTlIcGjsablpR6A4="
    strStatus = rsaVerifySignature(strSigBase64, strKeyFile, strMessage, True)
    Debug.Print "Result=" & strStatus

    ' Corrected version of Registo 2 in Especificacao [RE-1]
    strMessage = "2010-05-18;2010-05-18T15:43:25;FAC 001/15;25.62;" & _
        "Am1K5+CP4LDNVDZYvcLYGpnu8/1b+WWkzgoe8sbZhvk6QFzFvNN77Zsq+cHNm52jCVS" & _
        "EDgWLGHgPS1wcT8ZG7w6KgVq+2/VgOU+xKNt0lcC3gouyarZvcZpZclIReDgLh6m3nv8D" & _
        "YYHKAOQc+eCi/BQ4LqUnuJrca+7emgb/kpU="
    strSigBase64 = "hsR2TYJtl0mad+zVAhGxNLxs6matD+T8Y8IpEo12I3szSohdwwWVOfPclnu6D23pZ0w8g/Eh0TOMzYNsdkkUJpM68/nKH2d8ehI8HT85NUyLgrGhC8msXHK+ASCCOU0RN4mr04249IG+MuOAlnW8EcMJNZA+lTf94MbpJNqRYUw="
    strStatus = rsaVerifySignature(strSigBase64, strKeyFile, strMessage, True)
    Debug.Print "Result=" & strStatus

End Sub

' Extract the message digest from a given signature.
' (Use this in your debugging)

Public Sub Pt_ExtractDigest()
    Dim strKeyFile As String
    Dim strSigBase64 As String
    Dim strDigest As String
    
    ' Public key file we created ourselves
    strKeyFile = "Chave_Publica.txt"

    ' Signature in base64 form.
    strSigBase64 = "F8952fjEClltx2tF9m6/QTFynFjSuiboMslNZ1ag9oR5iIivgYYa0cNa0wJeWXlsf8QQVHUol303hp7XmIy5/kFOiV0Cv8QH6SF0Q5zNsDtpeFh2ZJ256y0DkJMSQqCq3oSka+9zIXXRkXgEsSv6VScCYv8VTlIcGjsablpR6A4="
    strDigest = rsaGetDigestFromBase64Signature(strSigBase64, strKeyFile)
    Debug.Print "DIGEST FOUND=" & strDigest
    Debug.Print "EXPECTED    =" & "BB5C0F8FF294016FA4F0A3265410249D275B0986"
End Sub


' Example to read in key files directly as a string...

' Use this as an alternative to passing filenames.
' The CryptoSys RSA_Read* functions will accept a string containing the file contents.
' You must still use the RSA_Read* functions to obtain the ephemeral "internal" key strings to use with the RSA_Raw* functions.

Public Sub Pt_CreateSignatureWithKeyAsString()
    Dim strMessage As String
    Dim strKeyFile As String
    Dim strSigBase64 As String
    Dim strDigest As String
    Dim strStatus As String

    ' As an alternative to passing a filename, you may instead pass the key data directly as a "PEM" string
    strKeyFile = _
        "-----BEGIN RSA PRIVATE KEY-----" & _
        "MIICXgIBAAKBgQDWDX9wVqj6ZqNZU1ojwBpyKKkuzHTCmfK39xx/T9vWkqpcV7h3sx++ZOv2KhhNkIe/1I4OCWDPCXRE4g0uIQr0NS29vMlP3aHHayy76+lbBCNVcHFxM0ggjre1acnD0qUpZ6Vza7F+PpCyuypD2V/pkL1nX9Z6z5uYyqc0XaSFdwIDAQABAoGBAJCA7j6Vkl/w+GeuOJUX9AK" & _
        "LZqN8TXquWUhOX4OnEt9Jhg7u/U55s31iPlWh12RNpQcg5IGfXSaH2GFEReeVUQGMrb89kkfbeY5HSRHh3/sBSyJTMn2cjsqfUnUJhywJPxT8NFIcS2pRBJe/QN/pL+M2jk+Fl40wyVXRhnog+4fhAkEA//Tijl5SA7a/uCyfOQkJ6yop13dfN4EHEWYMzI6SlnYWuJfdIOz4wkzBWgD0r/btFA" & _
        "ths1zElmRWINjWsB84ZwJBANYWywqsZA4FShXkDEWfG1GbrEIXiOnPJay2p7en3DQ+lx4GfE10iO52f54QRu13SZp06050YkrWcRfBGCXaYHECQQCU8vMsmmLr2ltzWDRIQqRM/7pdsw/sAuAUFej42Tcg7BOI1IdQc9bHa1dRgyDhjbalZYIzmJamVjlw3/7/ewudAkB/ipatpiP5YldPkUtqU" & _
        "q5QwOAvg5vSRtEYAr0KIZuDGGKoxY5aCnnlLn06qlHG+JDFzq+8ToOcOAKp9yQusNlRAkEA+0DarosTmn2I7+fj2/3ojVKdW/eIisz547U3bGbW/hBCZRi+y+cQnPlZ7Cr4LcGInhdxR+fSWptMNwrDCUiYHA==" & _
        "-----END RSA PRIVATE KEY-----"

    ' Exact message string to be signed:
    strMessage = "2008-03-10;2008-03-10T15:58:00;FT 1/1;28.07;"
    
    strSigBase64 = rsaCreateSignatureInBase64(strMessage, strKeyFile)
    
    Debug.Print "<Hash>=" & strSigBase64
    ' Expected signature = "F8952fjEClltx2tF9m6/...jsablpR6A4="
    
    ' Similarly, we can pass the public key data as a "PEM" string
    strKeyFile = _
        "-----BEGIN PUBLIC KEY-----" & _
        "MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDWDX9wVqj6ZqNZU1ojwBpyKKkuzHTCmfK39xx/T9vWkqpcV7h3sx++ZOv2KhhNkIe/1I4OCWDPCXRE4g0uIQr0NS29vMlP3aHHayy76+lbBCNVcHFxM0ggjre1acnD0qUpZ6Vza7F+PpCyuypD2V/pkL1nX9Z6z5uYyqc0XaSFdwIDAQAB" & _
        "-----END PUBLIC KEY-----"
        
    strDigest = rsaGetDigestFromBase64Signature(strSigBase64, strKeyFile)
    Debug.Print "DIGEST EXTRACTED=" & strDigest
   
    strStatus = rsaVerifySignature(strSigBase64, strKeyFile, strMessage)
    Debug.Print "Result=" & strStatus

End Sub

'****************************************************************************************************************
' THE FOLLOWING SHOWS HOW TO CREATE A PAIR OF RSA PUBLIC AND PRIVATE KEYS COMPATIBLE WITH THE OPENSSL PEM FORMAT.
' AND HOW TO CREATE AN X.509 CERTIFICATE FROM THE KEYS AND HOW TO VERIFY THAT A PAIR OF KEYS MATCH.
'****************************************************************************************************************

Public Sub Pt_Create_Keys()
' Create an RSA key pair
    Dim nRet As Long
    Dim strPublicKeyFile As String
    Dim strEncPrivateKeyFile As String
    Dim strPemPrivateKeyFile As String
    Dim strIntPrivateKey As String
    Dim strIntPublicKey As String
    Dim strPassword As String
    Dim nHashCodePub As Long
    Dim nHashCodePri As Long
    
    strPassword = "password"    ' Password for encrypted private key file (please pick something stronger!)
    
    ' OpenSSL commands to create an RSA key pair:
    '   cmd> openssl genrsa -out PrivateKey.PEM 1024
    '   cmd> openssl rsa -in PrivateKey.PEM -out PublicKey.PEM -outform PEM –pubout
    '
    strPublicKeyFile = "Pt_PublicKey.PEM"       ' This is created in OpenSSL PEM format
    strEncPrivateKeyFile = "Pt_PrivateKey.EPK"  ' This is in encrypted form
    strPemPrivateKeyFile = "Pt_PrivateKey.PEM"  ' This is in OpenSSL PEM format
    
    ' RSA_MakeKeys creates the key pair with an encrypted private key.
    Debug.Print "Creating keys. This may take a few seconds..."
    nRet = RSA_MakeKeys(strPublicKeyFile, strEncPrivateKeyFile, 1024, PKI_RSAEXP_EQ_65537, 128, 4096, strPassword, "", 0, PKI_KEY_FORMAT_SSL)
    Debug.Print "RSA_MakeKeys returns " & nRet & " (expected 0)"
    
    ' Adjust the white space in the public key file created here to suit the requirements of the DGCI.
    ' The file is a valid PEM format either way, but DGCI insists it should be exactly 272 bytes long.
    ' See <http://www.cryptosys.net/pki/portugal_DGCI_billing_software.html#key278vs272>.
    Call FixFileDosToUnix(strPublicKeyFile)
    
    ' To save the encrypted private key in unencrypted OpenSSL format, we read the key into an internal key string
    ' and then save to a file in the correct format.
    ' Note that the "internal" key string
    ' CAUTION: saving a production private key in unencrypted form is a huge security risk!
    strIntPrivateKey = rsaReadPrivateKey(strEncPrivateKeyFile, strPassword)
    If Len(strIntPrivateKey) = 0 Then
        MsgBox "Error reading encrypted private key file", vbCritical
        Exit Sub
    End If
    ' Now save in correct form
    nRet = RSA_SavePrivateKeyInfo(strPemPrivateKeyFile, strIntPrivateKey, PKI_KEY_FORMAT_SSL)
    Debug.Print "RSA_SavePrivateKeyInfo returns " & nRet & " (expected 0)"
    
    ' Do some checks that the OpenSSL keys match
    If Not Pt_DoKeyPairFilesMatch(strPemPrivateKeyFile, strPublicKeyFile) Then
        MsgBox "Error: keys do not match", vbCritical
        Exit Sub
    End If
    
End Sub

Public Function FixFileDosToUnix(strFileName As String) As Boolean
' Converts the line endings in a file from CR-LF pairs to single LF characters
    Dim strBuffer As String
    Dim hFile As Integer
    
    ' Check if file exists
    If Len(Dir(strFileName)) = 0 Then Exit Function
    ' Read in the file to a string
    hFile = FreeFile
    Open strFileName For Binary Access Read As #hFile
    strBuffer = Input(LOF(hFile), #hFile)
    Close #hFile
    ' Edit the string
    Debug.Print "Input is " & Len(strBuffer) & " bytes long"
    strBuffer = Replace(strBuffer, vbCrLf, vbLf)
    Debug.Print "Output is " & Len(strBuffer) & " bytes long"
    ' Re-write the file
    Kill strFileName
    hFile = FreeFile
    Open strFileName For Binary Access Write As #hFile
    Put #hFile, , strBuffer
    Close #hFile
    ' Success
    FixFileDosToUnix = True
    
End Function

Public Sub Pt_Test_DoKeyPairFilesMatch()
' Check that the two OpenSSL-format key files match...
    Dim strPublicKeyFile As String
    Dim strPemPrivateKeyFile As String
    
    strPublicKeyFile = "Pt_PublicKey.PEM"       ' This is in OpenSSL PEM format
    strPemPrivateKeyFile = "Pt_PrivateKey.PEM"  ' This is in OpenSSL PEM format
    
    If Not Pt_DoKeyPairFilesMatch(strPemPrivateKeyFile, strPublicKeyFile) Then
        Debug.Print "Error: keys do not match"
    Else
        Debug.Print "OK, keys match."
    End If
    
End Sub

Public Function Pt_DoKeyPairFilesMatch(strPemPrivateKeyFile As String, strPublicKeyFile As String) As Boolean
' Returns TRUE if the public and private keys in the given files match or FALSE if they do not.
    Dim nRet As Long
    Dim strIntPrivateKey As String
    Dim strIntPublicKey As String
    Dim nHashCodePub As Long
    Dim nHashCodePri As Long
    
    ' Read in the keys from the files to internal key strings
    strIntPrivateKey = rsaReadPrivateKeyInfo(strPemPrivateKeyFile)
    If Len(strIntPrivateKey) = 0 Then
        MsgBox "Error reading PEM private key file", vbCritical
        Exit Function
    End If
    strIntPublicKey = rsaReadPublicKey(strPublicKeyFile)
    If Len(strIntPublicKey) = 0 Then
        MsgBox "Error reading PEM private key file", vbCritical
        Exit Function
    End If
    ' Display the key lengths
    Debug.Print "Private key is " & RSA_KeyBits(strIntPrivateKey) & " bits"
    Debug.Print "Public key is  " & RSA_KeyBits(strIntPublicKey) & " bits"
    ' Display the "hashcode" (this is an internal hash code which should be equal for matching keys)
    nHashCodePri = RSA_KeyHashCode(strIntPrivateKey)
    nHashCodePub = RSA_KeyHashCode(strIntPublicKey)
    Debug.Print "Hashcodes are " & Hex(nHashCodePri) & " and " & Hex(nHashCodePub)
    ' Verify that a pair of "internal" RSA private and public key strings are matched
    nRet = RSA_KeyMatch(strIntPrivateKey, strIntPublicKey)
    Debug.Print "RSA_KeyMatch returns " & nRet & " (0 => keys match)"
    
    Pt_DoKeyPairFilesMatch = (nRet = 0)

End Function

Public Sub Pt_SavePrivateKeyAsEncrypted()
' Save an unencrypted OpenSSL private key in PKCS-8 encrypted form
    Dim nRet As Long
    Dim strEncPrivateKeyFile As String
    Dim strOpenSSLPrivateKeyFile As String
    Dim strIntPrivateKey As String
    Dim strPassword As String
    
    strOpenSSLPrivateKeyFile = "Pt_PrivateKey.pem"          ' This was created in unencrypted OpenSSL PEM format
    strEncPrivateKeyFile = "Pt_PrivateKeyEncrypted.pem"     ' This is in encrypted form
    strPassword = "password"    ' CAUTION: Pick something better than this!
    
    ' Read private key info into ephemeral internal string
    strIntPrivateKey = rsaReadPrivateKeyInfo(strOpenSSLPrivateKeyFile)
    ' Save in encrypted file form (set nCount to 2000 or so)
    nRet = RSA_SaveEncPrivateKey(strEncPrivateKeyFile, strIntPrivateKey, 2000, strPassword, PKI_KEY_FORMAT_PEM)
    Debug.Print "RSA_SaveEncPrivateKey returns " & nRet & " (expected 0)"
End Sub

Public Sub Pt_Make_X509_CertSelfSigned()
' Use the RSA key file to make a self-signed X.509 certificate containing the public key

' Requirements from [ESPECIF-2010] 5.2.2:
' Formato = x.509
' Charset = UTF-8
' Encoding = Base-64
' Endianess = Little Endian         [COMMENT: this is not relevant for X.509!]
' OAEP Padding = PKCS1 v1.5 padding [COMMENT: This is NOT "OAEP" padding]
' Tamanho da chave privada = 1024 bytes
' Formato do Hash da mensagem = SHA-1

    Dim nRet As Long
    Dim strPublicKeyFile As String
    Dim strEncPrivateKeyFile As String
    Dim strPassword As String
    Dim nKeyUsage As Long
    Dim nOptions As Long
    Dim strCertFile As String
    Dim strDN As String
    Dim nYearsValid As Long
    Dim nCertNum As Long
    
    ' With CryptoSys PKI we need to use the encrypted private key file we created with RSA_MakeKeys, not the OpenSSL one.
    strEncPrivateKeyFile = "Pt_PrivateKey.EPK"  ' This is in encrypted form
    strPassword = "password"            ' The password for the encrypted private key
    strCertFile = "Pt_SelfSigned.cer"   ' The certificate file we are going to create
    nYearsValid = 10                    ' Make this as long as you want.
    nCertNum = &H101                    ' Pick a number. Change this if you issue another certificate with a different key.
    ' The distinguished name of both the subject and the issuer of the certificate...
    strDN = "C=PT;O=Exemplo Organização;CN=Certificado auto-assinado"
    ' Options...
    nKeyUsage = PKI_X509_KEYUSAGE_DIGITALSIGNATURE + PKI_X509_KEYUSAGE_KEYCERTSIGN + PKI_X509_KEYUSAGE_CRLSIGN
    ' We want UTF-8 text and the output in PEM format...
    nOptions = PKI_X509_UTF8 + PKI_X509_FORMAT_PEM
    
    ' Create the certificate file
    Debug.Print "Creating self-signed X.509 certificate serial number 0x" & Hex(nCertNum) & " for subject '" & strDN & "'"
    nRet = X509_MakeCertSelf(strCertFile, strEncPrivateKeyFile, nCertNum, nYearsValid, strDN, "", nKeyUsage, strPassword, nOptions)
    Debug.Print "X509_MakeCertSelf returns " & nRet & " (expected 0)"

End Sub

Public Sub Pt_QueryCert()
' Query an X.509 certificate for selected information
    Dim nRet As Long
    Dim strOutput As String
    Dim strQuery As String
    Dim strCertFile As String
    
    strCertFile = "Pt_SelfSigned.cer"
    
    ' Make a large buffer to receive output
    strOutput = String(512, " ")
    
    Debug.Print "For certificate file " & strCertFile
    strQuery = "serialNumber"
    nRet = X509_QueryCert(strOutput, Len(strOutput), strCertFile, strQuery, 0)
    If nRet <= 0 Then Exit Sub  ' catch error
    Debug.Print strQuery & "=" & Left(strOutput, nRet)

    strQuery = "subjectName"
    ' NB use of option to obtain UTF-8-encoded name in Latin-1 format
    nRet = X509_QueryCert(strOutput, Len(strOutput), strCertFile, strQuery, PKI_X509_LATIN1)
    If nRet <= 0 Then Exit Sub  ' catch error
    Debug.Print strQuery & "=" & Left(strOutput, nRet)
    
    strQuery = "notAfter"
    nRet = X509_QueryCert(strOutput, Len(strOutput), strCertFile, strQuery, 0)
    If nRet <= 0 Then Exit Sub  ' catch error
    Debug.Print strQuery & "=" & Left(strOutput, nRet)

End Sub

Public Sub Pt_GetPublicKeyFromFileAndCert()
' Read the public key from both the original public key file and from the X.509 certificate we created.
' Display some info about the key.
    Dim strPublicKeyFile As String
    Dim strCertFile As String
    Dim strIntPublicKey As String
    strPublicKeyFile = "Pt_PublicKey.PEM"
    strCertFile = "Pt_SelfSigned.cer"
    
    ' NOTE:
    ' The internal key string is ephemeral and encrypted: it will be different each time you read it,
    ' although it will contain the same underlying key data..
    ' It is only intended for "internal" use by CryptoSys PKI functions like RSA_RawPublic in the same process.
    ' But the HashCode will always be the same for the same key value.
    
    ' Read in public key from file created by RSA_MakeKeys
    strIntPublicKey = rsaReadPublicKey(strPublicKeyFile)
    Debug.Print "Public key is  " & RSA_KeyBits(strIntPublicKey) & " bits"
    Debug.Print "HashCode=0x" & Hex(RSA_KeyHashCode(strIntPublicKey))
    Debug.Print Pt_GetPublicKeyAsXml(strIntPublicKey)
    ' Read in (the same) public key from certificate file
    strIntPublicKey = rsaGetPublicKeyFromCert(strCertFile)
    Debug.Print "Public key is  " & RSA_KeyBits(strIntPublicKey) & " bits"
    Debug.Print "HashCode=0x" & Hex(RSA_KeyHashCode(strIntPublicKey))
    Debug.Print Pt_GetPublicKeyAsXml(strIntPublicKey)
    
End Sub

Public Function Pt_GetPublicKeyAsXml(strIntPublicKey As String) As String
' Get the public key in <RSAKeyValue> XML form from an "internal" key string
    Dim strXml As String
    Dim nLen As String
    
    nLen = RSA_ToXMLString("", 0, strIntPublicKey, 0)
    If nLen <= 0 Then
        Exit Function
    End If
    strXml = String(nLen, " ")
    nLen = RSA_ToXMLString(strXml, Len(strXml), strIntPublicKey, 0)
    Pt_GetPublicKeyAsXml = strXml
    
End Function