crijndael.cls

The enclosed VB project includes a VB class that implements the Rijndael AES block encryption algori

    Dim ib      As Byte
    
    m_ltab(0) = 0
    m_ptab(0) = 1
    m_ltab(1) = 0
    m_ptab(1) = 3
    m_ltab(3) = 1
    
    For i = 2 To 255
        m_ptab(i) = m_ptab(i - 1) Xor xtime(m_ptab(i - 1))
        m_ltab(m_ptab(i)) = i
    Next
    
    m_fbsub(0) = &H63
    m_rbsub(&H63) = 0
    
    For i = 1 To 255
        ib = i
        y = ByteSub(ib)
        m_fbsub(i) = y
        m_rbsub(y) = i
    Next
    
        y = 1
    For i = 0 To 29
        m_rco(i) = y
        y = xtime(y)
    Next
    
    For i = 0 To 255
        y = m_fbsub(i)
        b(3) = y Xor xtime(y)
        b(2) = y
        b(1) = y
        b(0) = xtime(y)
        m_ftable(i) = Pack(b)
        
        y = m_rbsub(i)
        b(3) = bmul(m_InCo(0), y)
        b(2) = bmul(m_InCo(1), y)
        b(1) = bmul(m_InCo(2), y)
        b(0) = bmul(m_InCo(3), y)
        m_rtable(i) = Pack(b)
    Next
End Sub

'*******************************************************************************
' gkey (SUB)
'*******************************************************************************
Public Sub gkey(ByVal nb As Long, _
                ByVal nk As Long, _
                KEY() As Byte)
                
    Dim i               As Long
    Dim j               As Long
    Dim k               As Long
    Dim m               As Long
    Dim N               As Long
    Dim C1              As Long
    Dim C2              As Long
    Dim C3              As Long
    Dim CipherKey(7)    As Long
    
    m_Nb = nb
    m_Nk = nk
    
    If m_Nb >= m_Nk Then
        m_Nr = 6 + m_Nb
    Else
        m_Nr = 6 + m_Nk
    End If
    
    C1 = 1
    If m_Nb < 8 Then
        C2 = 2
        C3 = 3
    Else
        C2 = 3
        C3 = 4
    End If
    
    For j = 0 To nb - 1
        m = j * 3
        
        m_fi(m) = (j + C1) Mod nb
        m_fi(m + 1) = (j + C2) Mod nb
        m_fi(m + 2) = (j + C3) Mod nb
        m_ri(m) = (nb + j - C1) Mod nb
        m_ri(m + 1) = (nb + j - C2) Mod nb
        m_ri(m + 2) = (nb + j - C3) Mod nb
    Next
    
    N = m_Nb * (m_Nr + 1)
    
    For i = 0 To m_Nk - 1
        j = i * 4
        CipherKey(i) = PackFrom(KEY, j)
    Next
    
    For i = 0 To m_Nk - 1
        m_fkey(i) = CipherKey(i)
    Next
    
    j = m_Nk
    k = 0
    Do While j < N
        m_fkey(j) = m_fkey(j - m_Nk) Xor _
            SubByte(RotateLeft(m_fkey(j - 1), 24)) Xor m_rco(k)
        If m_Nk <= 6 Then
            i = 1
            Do While i < m_Nk And (i + j) < N
                m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _
                    m_fkey(i + j - 1)
                i = i + 1
            Loop
        Else
            ' Problem fixed here
            i = 1
            Do While i < 4 And (i + j) < N
                m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _
                    m_fkey(i + j - 1)
                i = i + 1
            Loop
            If j + 4 < N Then
                m_fkey(j + 4) = m_fkey(j + 4 - m_Nk) Xor _
                    SubByte(m_fkey(j + 3))
            End If
            i = 5
            Do While i < m_Nk And (i + j) < N
                m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor _
                    m_fkey(i + j - 1)
                i = i + 1
            Loop
        End If
        
        j = j + m_Nk
        k = k + 1
    Loop
    
    For j = 0 To m_Nb - 1
        m_rkey(j + N - nb) = m_fkey(j)
    Next
    
    i = m_Nb
    Do While i < N - m_Nb
        k = N - m_Nb - i
        For j = 0 To m_Nb - 1
            m_rkey(k + j) = InvMixCol(m_fkey(i + j))
        Next
        i = i + m_Nb
    Loop
    
    j = N - m_Nb
    Do While j < N
        m_rkey(j - N + m_Nb) = m_fkey(j)
        j = j + 1
    Loop
End Sub

'*******************************************************************************
' encrypt (SUB)
'*******************************************************************************
Public Sub Encrypt(buff() As Byte)
    Dim i       As Long
    Dim j       As Long
    Dim k       As Long
    Dim m       As Long
    Dim a(7)    As Long
    Dim b(7)    As Long
    Dim x()     As Long
    Dim y()     As Long
    Dim t()     As Long
    
    For i = 0 To m_Nb - 1
        j = i * 4
        
        a(i) = PackFrom(buff, j)
        a(i) = a(i) Xor m_fkey(i)
    Next
    
    k = m_Nb
    x = a
    y = b
    
    For i = 1 To m_Nr - 1
        For j = 0 To m_Nb - 1
            m = j * 3
            y(j) = m_fkey(k) Xor m_ftable(x(j) And m_lOnBits(7)) Xor _
                RotateLeft(m_ftable(RShift(x(m_fi(m)), 8) And m_lOnBits(7)), 8) Xor _
                RotateLeft(m_ftable(RShift(x(m_fi(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
                RotateLeft(m_ftable(RShift(x(m_fi(m + 2)), 24) And m_lOnBits(7)), 24)
            k = k + 1
        Next
        t = x
        x = y
        y = t
    Next
    
    For j = 0 To m_Nb - 1
        m = j * 3
        y(j) = m_fkey(k) Xor m_fbsub(x(j) And m_lOnBits(7)) Xor _
            RotateLeft(m_fbsub(RShift(x(m_fi(m)), 8) And m_lOnBits(7)), 8) Xor _
            RotateLeft(m_fbsub(RShift(x(m_fi(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
            RotateLeft(m_fbsub(RShift(x(m_fi(m + 2)), 24) And m_lOnBits(7)), 24)
        k = k + 1
    Next
    
    For i = 0 To m_Nb - 1
        j = i * 4
        UnpackFrom y(i), buff, j
        x(i) = 0
        y(i) = 0
    Next
End Sub

'*******************************************************************************
' decrypt (SUB)
'*******************************************************************************
Public Sub Decrypt(buff() As Byte)
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim m As Long
    Dim a(7) As Long
    Dim b(7) As Long
    Dim x() As Long
    Dim y() As Long
    Dim t() As Long
    
    For i = 0 To m_Nb - 1
        j = i * 4
        a(i) = PackFrom(buff, j)
        a(i) = a(i) Xor m_rkey(i)
    Next
    
    k = m_Nb
    x = a
    y = b
    
    For i = 1 To m_Nr - 1
        For j = 0 To m_Nb - 1
            m = j * 3
            y(j) = m_rkey(k) Xor m_rtable(x(j) And m_lOnBits(7)) Xor _
                RotateLeft(m_rtable(RShift(x(m_ri(m)), 8) And m_lOnBits(7)), 8) Xor _
                RotateLeft(m_rtable(RShift(x(m_ri(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
                RotateLeft(m_rtable(RShift(x(m_ri(m + 2)), 24) And m_lOnBits(7)), 24)
            k = k + 1
        Next
        t = x
        x = y
        y = t
    Next
    
    For j = 0 To m_Nb - 1
        m = j * 3
        
        y(j) = m_rkey(k) Xor m_rbsub(x(j) And m_lOnBits(7)) Xor _
            RotateLeft(m_rbsub(RShift(x(m_ri(m)), 8) And m_lOnBits(7)), 8) Xor _
            RotateLeft(m_rbsub(RShift(x(m_ri(m + 1)), 16) And m_lOnBits(7)), 16) Xor _
            RotateLeft(m_rbsub(RShift(x(m_ri(m + 2)), 24) And m_lOnBits(7)), 24)
        k = k + 1
    Next
    
    For i = 0 To m_Nb - 1
        j = i * 4
        
        UnpackFrom y(i), buff, j
        x(i) = 0
        y(i) = 0
    Next
End Sub

''*******************************************************************************
'' CopyBytesASP (SUB)
''
'' Slower non-API function you can use to copy array data
''*******************************************************************************
'Private Sub CopyBytesASP(bytDest() As Byte, _
'                         lDestStart As Long, _
'                         bytSource() As Byte, _
'                         lSourceStart As Long, _
'                         lLength As Long)
'    Dim lCount As Long
'
'    lCount = 0
'    Do
'        bytDest(lDestStart + lCount) = bytSource(lSourceStart + lCount)
'        lCount = lCount + 1
'    Loop Until lCount = lLength
'End Sub

'*******************************************************************************
' IsInitialized (FUNCTION)
'*******************************************************************************
Private Function IsInitialized(ByRef vArray As Variant) As Boolean
    On Error Resume Next
    
    IsInitialized = IsNumeric(UBound(vArray))
End Function

'*******************************************************************************
' EncryptData (FUNCTION)
'
' Takes the message, whatever the size, and password in one call and does
' everything for you to return an encoded/encrypted message
'*******************************************************************************
Public Function EncryptData(bytMessage() As Byte, _
                            bytPassword() As Byte) As Byte()
    Dim bytKey(31)      As Byte
    Dim bytIn()         As Byte
    Dim bytOut()        As Byte
    Dim bytTemp(31)     As Byte
    Dim lCount          As Long
    Dim lLength         As Long
    Dim lEncodedLength  As Long
    Dim bytLen(3)       As Byte
    Dim lPosition       As Long
    
    If Not IsInitialized(bytMessage) Then
        Exit Function
    End If
    If Not IsInitialized(bytPassword) Then
        Exit Function
    End If
    
    ' Use first 32 bytes of the password for the key
    For lCount = 0 To UBound(bytPassword)
        bytKey(lCount) = bytPassword(lCount)
        If lCount = 31 Then
            Exit For
        End If
    Next
    
    ' Prepare the key; assume 256 bit block and key size
    gentables
    gkey 8, 8, bytKey
    
    ' We are going to put the message size on the front of the message
    ' in the first 4 bytes. If the length is more than a max int we are
    ' in trouble
    lLength = UBound(bytMessage) + 1
    lEncodedLength = lLength + 4
    
    ' The encoded length includes the 4 bytes stuffed on the front
    ' and is padded out to be modulus 32
    If lEncodedLength Mod 32 <> 0 Then
        lEncodedLength = lEncodedLength + 32 - (lEncodedLength Mod 32)
    End If
    ReDim bytIn(lEncodedLength - 1)
    ReDim bytOut(lEncodedLength - 1)
    
    ' Put the length on the front
    '* Unpack lLength, bytIn
    CopyMemory VarPtr(bytIn(0)), VarPtr(lLength), 4
    ' Put the rest of the message after it
    '* CopyBytesASP bytIn, 4, bytMessage, 0, lLength
    CopyMemory VarPtr(bytIn(4)), VarPtr(bytMessage(0)), lLength

    ' Encrypt a block at a time
    For lCount = 0 To lEncodedLength - 1 Step 32
        '* CopyBytesASP bytTemp, 0, bytIn, lCount, 32
        CopyMemory VarPtr(bytTemp(0)), VarPtr(bytIn(lCount)), 32
        Encrypt bytTemp
        '* CopyBytesASP bytOut, lCount, bytTemp, 0, 32
        CopyMemory VarPtr(bytOut(lCount)), VarPtr(bytTemp(0)), 32
    Next
    
    EncryptData = bytOut
End Function

'*******************************************************************************
' DecryptData (FUNCTION)
'
' Opposite of Encryptdata
'*******************************************************************************
Public Function DecryptData(bytIn() As Byte, _
                            bytPassword() As Byte) As Byte()
    Dim bytMessage()    As Byte
    Dim bytKey(31)      As Byte
    Dim bytOut()        As Byte
    Dim bytTemp(31)     As Byte
    Dim lCount          As Long
    Dim lLength         As Long
    Dim lEncodedLength  As Long
    Dim bytLen(3)       As Byte
    Dim lPosition       As Long
    
    If Not IsInitialized(bytIn) Then
        Exit Function
    End If
    If Not IsInitialized(bytPassword) Then
        Exit Function
    End If
    
    lEncodedLength = UBound(bytIn) + 1
    
    If lEncodedLength Mod 32 <> 0 Then
        Exit Function
    End If
    
    ' Use first 32 bytes of the password for the key
    For lCount = 0 To UBound(bytPassword)
        bytKey(lCount) = bytPassword(lCount)
        If lCount = 31 Then
            Exit For
        End If
    Next
    
    ' Prepare the key; assume 256 bit block and key size
    gentables
    gkey 8, 8, bytKey

    ' The output array needs to be the same size as the input array
    ReDim bytOut(lEncodedLength - 1)
    
    ' Decrypt a block at a time
    For lCount = 0 To lEncodedLength - 1 Step 32
        '* CopyBytesASP bytTemp, 0, bytIn, lCount, 32
        CopyMemory VarPtr(bytTemp(0)), VarPtr(bytIn(lCount)), 32
        Decrypt bytTemp
        '* CopyBytesASP bytOut, lCount, bytTemp, 0, 32
        CopyMemory VarPtr(bytOut(lCount)), VarPtr(bytTemp(0)), 32
    Next

    ' Get the original length of the string from the first 4 bytes
    '* lLength = Pack(bytOut)
    CopyMemory VarPtr(lLength), VarPtr(bytOut(0)), 4
    
    ' Make sure the length is consistent with our data
    If lLength > lEncodedLength - 4 Then
        Exit Function
    End If
    
    ' Prepare the output message byte array
    ReDim bytMessage(lLength - 1)
    '* CopyBytesASP bytMessage, 0, bytOut, 4, lLength
    CopyMemory VarPtr(bytMessage(0)), VarPtr(bytOut(4)), lLength
    
    DecryptData = bytMessage
End Function