Código: Seleccionar todo

Attribute VB_Name = "basEncryptExample"
Option Explicit

' This example shows how you could use the RSA_Raw functions
' to carry out encryption and decryption of a short message
' using a 512-bit RSA key. Please read the comments below.

' Last updated:
'   $Date: 2006-06-27 04:20:00 $

' Include the module basCrPKI in your project
' from the CryptoSys PKI toolkit

' ******************************************************************
' COMMENTS ON THIS CODE
'
' 1. This code is given as an example of how you could use RSA to
' encrypt a short message directly.
'
' 2. In practice, the method is used to encrypt a random "session
' key" or "Content Encryption Key" (CEK) and pass that key securely
' between two parties. The longer message is then encrypted using
' faster symmetrical encryption like Triple DES or AES.
'
' 3. The methods used here to create and read the encryption block
' can be done much faster using the RSA_EncodeMsg and RSA_DecodeMsg
' functions.
'
' 4. In practice, too, the public key is usually provided in a
' public key certificate file (X.509 file).
'
' 5. In an earlier version we hinted that the key strings could be
' hardcoded. We lied. ALWAYS read in the private and public key
' values from the files each time you use them.
'
' 6. Treat the private key string as the very important secret that
' it is. NEVER print it out or save it to disk. Always use the
' WIPE_String function immediately you have finished with it.
' ******************************************************************

Public Function TestEncrypt()
    Dim strPlain As String
    Dim lngRet As Long
    Dim nBlockLen As Long
    Dim nBytes As Long
    Dim nPad As Long
    Dim sPublicKeyFile As String
    Dim sPrivateKeyFile As String
    Dim strPublicKey As String
    Dim strPrivateKey As String
    Dim strPassword As String
    Dim abBlock() As Byte
    Dim abPlain() As Byte
    Dim i As Integer
    Dim iOffset As Integer
    Dim abResult() As Byte
    Dim strResult As String
   
    ' Some keys we prepared earlier (see CreateTestKeys)
    sPublicKeyFile = App.Path & "\" & "ourkeypub.bin"
    sPrivateKeyFile = App.Path & "\" & "ourkeypri.bin"
    ' Our bad example hard-coded password...
    strPassword = "password"
   
    ' (1) In this first part of the example, we are the sending party
    ' We have the recipient's public key which is generally available
   
    ' Read in the public key as base64 string
    strPublicKey = rsaReadPublicKey(sPublicKeyFile)
   
    ' Check for error
    If Len(strPublicKey) = 0 Then
        MsgBox "Could not read public key file " & sPublicKeyFile, vbCritical
        Exit Function
    End If
   
    ' Check its length - it should be 64 bytes (512 bits)
    nBlockLen = RSA_KeyBytes(strPublicKey)
    If nBlockLen <= 0 Then  ' (you could be more specific here and check for the exact length)
        MsgBox "Error with public key length", vbCritical
        Exit Function
    End If
    Debug.Print "Public key is " & nBlockLen & " bytes long (" & RSA_KeyBits(strPublicKey) & " bits)"
   
    ' [Do not hardcode this key - always read it in from the public key file or certificate]
   
    ' Get the text we want to encrypt (max (64-10)= 54 bytes long)
    strPlain = "My secret text here...!"
    Debug.Print "DATA=" & strPlain
   
    ' Convert to bytes
    abPlain = StrConv(strPlain, vbFromUnicode)
    ' Show in hex
    Debug.Print "DATA=" & cnvHexStrFromBytes(abPlain)
    ' Check exact length in bytes
    nBytes = UBound(abPlain) - LBound(abPlain) + 1
   
    ' Construct encryption block of exactly 64 bytes
    ReDim abBlock(nBlockLen - 1)
   
    ' Required encryption block (Ref: EME-PKCS1-V1_5-ENCODE from PKCS#1)
    '|<------------------(64 bytes)---------------->|
    '+--+--+-------+--+-----------------------------+
    '|00|02|PADDING|00|      DATA TO ENCRYPT        |
    '+--+--+-------+--+-----------------------------+
   
    ' [NOTE: this can now be done using the RSA_EncodeMsg function.
    ' We keep this method here as an example of general byte manipulation techniques.]
   
    ' First byte is always 00
    abBlock(0) = 0
    ' Second byte is always 02
    abBlock(1) = 2
    ' Then pad with at least 8 non-zero random bytes
    nPad = nBlockLen - 3 - nBytes
   
    If nPad < 8 Then
        MsgBox "Data is too long/ key is too short"
        Exit Function
    End If
   
    ' The random bytes just need to be different from before
    ' so we don't need to use the secure generator
    Randomize
    iOffset = 2
    For i = 0 To nPad - 1
        Do
            abBlock(iOffset + i) = Int(Rnd() * 256) And &HFF
        Loop While abBlock(iOffset + i) = 0
    Next
    iOffset = iOffset + nPad
   
    ' Separating NUL byte
    abBlock(iOffset) = 0
    iOffset = iOffset + 1
   
    ' Then the data to be encrypted
    For i = 0 To nBytes - 1
        abBlock(iOffset + i) = abPlain(i)
    Next
   
    ' Show the block in hex
    Debug.Print "BLCK=" & cnvHexStrFromBytes(abBlock)
   
    ' Given the encrypted data in abBlock,
    ' we use the RSA function to encrypt the input block using the public key
    lngRet = RSA_RawPublic(abBlock(0), nBlockLen, strPublicKey, 0)
    Debug.Print "RSA_RawPublic returns " & lngRet
   
    ' Display our results in hex format
    Debug.Print "ENCR=" & cnvHexStrFromBytes(abBlock)
   
    ' Now we send the 64 bytes of ciphertext in abBlock to our recipient
    ' (Either encode them first in hex or base64, or save in a binary file and send that)
    ' Note that the ciphertext will be completely different each time
    ' even for the same text with the same key, because of the random padding
   
    ' -------
   
    ' (2) In this second part of the example, we are the recipient decrypting the data
    ' We have our private key, which we keep secret. We assume the sender has used our public key.
    ' No one can use the public key to decrypt the original ciphertext
   
    ' Read in the private key as an "internal" string
    ' NEVER hardcode this value.
    strPrivateKey = rsaReadPrivateKey(sPrivateKeyFile, strPassword)
   
    ' Check for error
    If Len(strPrivateKey) = 0 Then
        MsgBox "Could not read private key file " & sPrivateKeyFile, vbCritical
        Exit Function
    End If
   
    ' (IMPORTANT: it's up to you to manage the security of the private key file and its password)
   
    ' Check its length - it should be 64 bytes (512 bits)
    nBlockLen = RSA_KeyBytes(strPrivateKey)
    If nBlockLen <= 0 Then  '(you could be more specific here and check for the exact length)
        MsgBox "Error with private key length", vbCritical
        Exit Function
    End If
    Debug.Print "Private key is " & nBlockLen & " bytes long (" & RSA_KeyBits(strPrivateKey) & " bits)"
   
    ' Given the encrypted data in abBlock,
    ' we use the RSA function to decrypt the input block using the private key
    lngRet = RSA_RawPrivate(abBlock(0), nBlockLen, strPrivateKey, 0)
    Debug.Print "RSA_RawPrivate returns " & lngRet
    If lngRet <> 0 Then
        Debug.Print pkiGetLastError()
        Exit Function
    Else
        ' Display our results in hex format
        Debug.Print "DECR=" & cnvHexStrFromBytes(abBlock)
    End If
   
    ' We are done with the private key and password now, so clear the strings
    Call WIPE_String(strPrivateKey, Len(strPrivateKey))
    Call WIPE_String(strPassword, Len(strPassword))
   
    ' Extract the plaintext from the resulting block
    If abBlock(0) <> 0 Then
        MsgBox "Decryption error"
        Exit Function
    End If
    If abBlock(1) <> 2 Then
        MsgBox "Decryption error"
        Exit Function
    End If
   
    ' So far so good, we should have non-zero padding until we find a 0
    ' before the end
    For i = 1 To nBlockLen - 1
        If abBlock(i) = 0 Then
            ' Found start of real data we want
            Exit For
        End If
    Next
   
    ' Copy result we want
    nBytes = nBlockLen - i - 1
    ReDim abResult(nBytes - 1)
    For i = i + 1 To nBlockLen - 1
        abResult(i - nBlockLen + nBytes) = abBlock(i)
    Next
   
    ' Convert to a string
    strResult = StrConv(abResult, vbUnicode)
   
    ' Do something with it
    Debug.Print strResult
   
End Function


Public Function CreateTestKeys()
' Do this once. The sending party keeps the private key and keeps its password secret.
' The public key can be given to anyone. The receiving party needs this.
' NB re-running this function will create a completely new set of keys - BE CAREFUL
    Dim lngRet As Long
    Dim nChars As Long
    Dim sPublicKeyFile As String
    Dim sPrivateKeyFile As String
    Dim strPublicKey As String
    Dim strPrivateKey As String
    Dim strPassword As String
   
    ' scTESTDIR is defined above
    sPublicKeyFile = "ourkeypub.bin"
    sPrivateKeyFile = "ourkeypri.bin"
    ' In practice, never hardcode a password (or use such a simple one)
    ' this is just a demo...
    strPassword = "password"
   
    ' Create a new pair of RSA keys saved as BER-encoded files
    Debug.Print "About to create a new RSA key pair..."
   
    lngRet = RSA_MakeKeys(sPublicKeyFile, sPrivateKeyFile, 512, PKI_RSAEXP_EQ_3, _
        50, 1000, strPassword, "", 0, PKI_DEFAULT)
    Debug.Print "RSA_MakeKeys returns " & lngRet & " (expected 0)"
   
    ' As a check, read in the keys as base64 strings - getting the length first
    nChars = RSA_ReadPublicKey(vbNullString, 0, sPublicKeyFile, 0)
    If nChars > 0 Then
        strPublicKey = String(nChars, " ")
        lngRet = RSA_ReadPublicKey(strPublicKey, nChars, sPublicKeyFile, 0)
        Debug.Print "RSA_ReadPublicKey returns " & lngRet
        Debug.Print RSA_KeyBits(strPublicKey) & " bits"
        Debug.Print RSA_KeyBytes(strPublicKey) & " Bytes"
    Else
        MsgBox "Unable to read public key. Error=" & nChars & vbCrLf & pkiErrorLookup(nChars)
    End If
    nChars = RSA_ReadEncPrivateKey(vbNullString, 0, sPrivateKeyFile, strPassword, 0)
    If nChars > 0 Then
        strPrivateKey = String(nChars, " ")
        lngRet = RSA_ReadEncPrivateKey(strPrivateKey, nChars, sPrivateKeyFile, strPassword, 0)
        Debug.Print "RSA_ReadEncPrivateKey returns " & lngRet
        Debug.Print RSA_KeyBits(strPrivateKey) & " bits"
        Debug.Print RSA_KeyBytes(strPrivateKey) & " Bytes"
    Else
        MsgBox "Unable to read private key. Error=" & nChars & vbCrLf & pkiErrorLookup(nChars)
    End If

End Function