rijndael.cls

It use both RSA and AES for encry/decryption with fingerprint as Key.

    t0 = t0 Xor rkey(0)
    t1 = t1 Xor rkey(1)
    t2 = t2 Xor rkey(2)
    t3 = t3 Xor rkey(3)
    k = 4

    For i = 1 To Nr - 1 'Nr is number of rounds
        CopyMemory s(0), t0, 4&
        CopyMemory s(4), t1, 4&
        CopyMemory s(8), t2, 4&
        CopyMemory s(12), t3, 4&
        t0 = Td0(s(0)) Xor Td1(s(13)) Xor Td2(s(10)) Xor Td3(s(7)) Xor rkey(k + 0)
        t1 = Td0(s(4)) Xor Td1(s(1)) Xor Td2(s(14)) Xor Td3(s(11)) Xor rkey(k + 1)
        t2 = Td0(s(8)) Xor Td1(s(5)) Xor Td2(s(2)) Xor Td3(s(15)) Xor rkey(k + 2)
        t3 = Td0(s(12)) Xor Td1(s(9)) Xor Td2(s(6)) Xor Td3(s(3)) Xor rkey(k + 3)
        k = k + 4
    Next i

    'Final round
    CopyMemory s(0), t0, 4&
    CopyMemory s(4), t1, 4&
    CopyMemory s(8), t2, 4&
    CopyMemory s(12), t3, 4&
    t0 = (Td4(s(0)) And &HFF&) Xor (Td4(s(13)) And &HFF00&) Xor (Td4(s(10)) And &HFF0000) Xor (Td4(s(7)) And &HFF000000) Xor rkey(k + 0)
    t1 = (Td4(s(4)) And &HFF&) Xor (Td4(s(1)) And &HFF00&) Xor (Td4(s(14)) And &HFF0000) Xor (Td4(s(11)) And &HFF000000) Xor rkey(k + 1)
    t2 = (Td4(s(8)) And &HFF&) Xor (Td4(s(5)) And &HFF00&) Xor (Td4(s(2)) And &HFF0000) Xor (Td4(s(15)) And &HFF000000) Xor rkey(k + 2)
    t3 = (Td4(s(12)) And &HFF&) Xor (Td4(s(9)) And &HFF00&) Xor (Td4(s(6)) And &HFF0000) Xor (Td4(s(3)) And &HFF000000) Xor rkey(k + 3)
    CopyMemory plaintext(p + 0), t0, 4&
    CopyMemory plaintext(p + 4), t1, 4&
    CopyMemory plaintext(p + 8), t2, 4&
    CopyMemory plaintext(p + 12), t3, 4&
End Sub
'File decryption.
Public Function FileDecrypt(PlaintextFileName As String, CiphertextFileName As String) As Long
    Dim FileNum     As Integer
    Dim FileNum2    As Integer
    Dim i           As Long
    Dim m           As Long 'ciphertext file size
    Dim n           As Long 'plaintext file size
    Dim data()      As Byte
    Const BlockSize As Long = 16 'bytes
    Const MaxBlocks As Long = MaxFileChunkSize \ BlockSize

    m = FileLen(CiphertextFileName)
    If (m = 0) Or ((m And (BlockSize - 1)) <> 0) Then 'BlockSize=16 specific
        MsgBox "File Size Error - ciphertext file not a multiple of block size"
        FileDecrypt = 1
    Else
        FileNum = FreeFile
        Open CiphertextFileName For Binary Access Read As FileNum
        FileNum2 = FreeFile
        Open PlaintextFileName For Binary Access Write As FileNum2

        'For large files, decrypt in pieces no larger than MaxFileChunkSize
        If m > MaxBlocks * BlockSize Then
            ReDim data(MaxBlocks * BlockSize - 1)
            Do
                Get #FileNum, , data
                For i = 0 To (MaxBlocks - 1) * BlockSize Step BlockSize
                    BlockDecrypt data, data, i, i
                Next i
                
                Put #FileNum2, , data
                m = m - MaxBlocks * BlockSize
            Loop While m > MaxBlocks * BlockSize
        End If

        'Decrypt the last piece of the file
        ReDim data(m - 1)
        Get #FileNum, , data
        
        For i = 0 To m - BlockSize Step BlockSize
            BlockDecrypt data, data, i, i
        Next i
        
        'Recover length field
        If data(m - 1) < BlockSize Then
            n = m - BlockSize + CLng(data(m - 1))
        Else
            MsgBox "warning - incorrect length field in decrypted file." & vbCrLf & "Wrong key or keysize?"
            n = m
        End If
        If n > 0 Then
            ReDim Preserve data(n - 1)
            Put FileNum2, , data
        End If

        Close FileNum
        Close FileNum2
    End If
End Function


Private Sub Class_Initialize()
#If COMPILE_CONSTANTS = 0 Then
    Dim i          As Long
    Dim y          As Byte
    Dim s(7)       As Byte
    Dim ib         As Byte
    Dim ptab(255)  As Byte
    Dim ltab(255)  As Byte

    'use 3 as primitive root to generate power and log tables
    ltab(0) = 0
    ltab(1) = 0
    ltab(3) = 1
    ptab(0) = 1
    ptab(1) = 3
    For i = 2 To 255 'ptab(i) = ptab(i - 1) Xor Xtime(ptab(i - 1))
        If (ptab(i - 1) And &H80) Then
            ptab(i) = ptab(i - 1) Xor ((ptab(i - 1) And 127) * 2) Xor &H1B
        Else
            ptab(i) = ptab(i - 1) Xor (ptab(i - 1) * 2)
        End If
        ltab(ptab(i)) = i
    Next i

    'affine transformation:- each bit is xored with itself shifted one bit
    Te4(0) = &H63636363
    Td4(&H63) = 0
    For i = 1 To 255
        y = ptab(255 - ltab(i)) 'multiplicative inverse
        ib = y
        If ib And &H80 Then ib = (ib And 127) * 2 Or 1 Else ib = ib * 2 'RotateLeftByte