Description
mdAES.bas is a pure VB6 implementation of AES block cipher and AES in CBC mode w/ PKCS#5 padding.
Usage
First you have to initialize AES context with CryptoAesInit (incl. initial Nonce for CBC), then to encrypt a byte-array in-place call CryptoAesCbcEncrypt with parameter Finalize:=False as a streaming API until the final chunk.
Keep in mind that in CBC mode all chunks except the final one must be multiple of AES block size (16 bytes) and the final one is padded to AES block size (16 bytes) so output ciphertext size might be bigger than input plaintext which is normal.
As a consequence of appended padding the CryptoAesCbcDecrypt function accepts encrypted ciphertext chunks only in multiples of block size (16 bytes) and decrypts these in-place until final chunk which gets resized to actual plaintext size as it were before padding.
Compiled VB6 code w/ all optimizatins is quite performant and you can expect rates of ~180MB/s encrypting and ~150MB/s decrypting in CBC mode and additionally calculating MAC will obvisouly make some dent on these rates.
cheers,
</wqw>
mdAES.bas is a pure VB6 implementation of AES block cipher and AES in CBC mode w/ PKCS#5 padding.
Usage
First you have to initialize AES context with CryptoAesInit (incl. initial Nonce for CBC), then to encrypt a byte-array in-place call CryptoAesCbcEncrypt with parameter Finalize:=False as a streaming API until the final chunk.
Keep in mind that in CBC mode all chunks except the final one must be multiple of AES block size (16 bytes) and the final one is padded to AES block size (16 bytes) so output ciphertext size might be bigger than input plaintext which is normal.
As a consequence of appended padding the CryptoAesCbcDecrypt function accepts encrypted ciphertext chunks only in multiples of block size (16 bytes) and decrypts these in-place until final chunk which gets resized to actual plaintext size as it were before padding.
Compiled VB6 code w/ all optimizatins is quite performant and you can expect rates of ~180MB/s encrypting and ~150MB/s decrypting in CBC mode and additionally calculating MAC will obvisouly make some dent on these rates.
Code:
'--- mdAES.bas
Option Explicit
DefObj A-Z
#Const HasPtrSafe = (VBA7 <> 0)
#Const HasOperators = (TWINBASIC <> 0)
#If HasPtrSafe Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Enum LongPtr
[_]
End Enum
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#End If
Private Const LNG_BLOCKSZ As Long = 16
Private Const LNG_POW2_1 As Long = 2 ^ 1
Private Const LNG_POW2_2 As Long = 2 ^ 2
Private Const LNG_POW2_3 As Long = 2 ^ 3
Private Const LNG_POW2_4 As Long = 2 ^ 4
Private Const LNG_POW2_7 As Long = 2 ^ 7
Private Const LNG_POW2_8 As Long = 2 ^ 8
Private Const LNG_POW2_16 As Long = 2 ^ 16
Private Const LNG_POW2_23 As Long = 2 ^ 23
Private Const LNG_POW2_24 As Long = 2 ^ 24
Private Type ArrayByte256
Item(0 To 255) As Byte
End Type
Private Type ArrayLong256
Item(0 To 255) As Long
End Type
Private Type AesTables
Item(0 To 3) As ArrayLong256
End Type
Private Type ArrayLong4
Item(0 To 3) As Long
End Type
Private Type ArrayLong60
Item(0 To 59) As Long
End Type
Private m_uEncTables As AesTables
Private m_uDecTables As AesTables
Private m_uSbox As ArrayByte256
Private m_uSboxInv As ArrayByte256
Public Type CryptoAesContext
KeyLen As Long
EncKey As ArrayLong60
DecKey As ArrayLong60
Nonce As ArrayLong4
End Type
Private Sub pvInit(uEncTable As AesTables, uDecTable As AesTables, uSbox As ArrayByte256, uSboxInv As ArrayByte256)
Dim lIdx As Long
Dim uDbl As ArrayByte256
Dim uThd As ArrayByte256
Dim lX As Long
Dim lX2 As Long
Dim lX4 As Long
Dim lX8 As Long
Dim lXInv As Long
Dim lS As Long
Dim lDec As Long
Dim lEnc As Long
Dim lTemp As Long
'--- double and third tables
For lIdx = 0 To 255
#If HasOperators Then
lTemp = (lIdx << 1) Xor (lIdx >> 7) * 283
#Else
lTemp = (lIdx * LNG_POW2_1) Xor (lIdx \ LNG_POW2_7) * 283
#End If
uDbl.Item(lIdx) = lTemp
uThd.Item(lTemp Xor lIdx) = lIdx
Next
Do While uSbox.Item(lX) = 0
'--- sbox
lS = lXInv Xor lXInv * LNG_POW2_1 Xor lXInv * LNG_POW2_2 Xor lXInv * LNG_POW2_3 Xor lXInv * LNG_POW2_4
#If HasOperators Then
lS = (lS >> 8) Xor (lS And 255) Xor 99
#Else
lS = (lS \ LNG_POW2_8) Xor (lS And 255) Xor 99
#End If
uSbox.Item(lX) = lS
uSboxInv.Item(lS) = lX
'--- mixcolumns
lX2 = uDbl.Item(lX)
lX4 = uDbl.Item(lX2)
lX8 = uDbl.Item(lX4)
#If HasOperators Then
lDec = lX8 * &H1010101 Xor lX4 * &H10001 Xor lX2 * &H101& Xor lX * &H1010100
lEnc = uDbl.Item(lS) * &H101& Xor lS * &H1010100
#Else
lDec = ((lX8 And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lX8 And LNG_POW2_7) <> 0) * &H80000000) Xor lX8 * &H10101 _
Xor lX4 * &H10001 _
Xor lX2 * &H101& _
Xor ((lX And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lX And LNG_POW2_7) <> 0) * &H80000000) Xor lX * &H10100
lEnc = uDbl.Item(lS) * &H101& _
Xor ((lS And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lS And LNG_POW2_7) <> 0) * &H80000000) Xor lS * &H10100
#End If
For lIdx = 0 To 3
#If HasOperators Then
lEnc = (lEnc << 24) Xor (lEnc >> 8)
lDec = (lDec << 24) Xor (lDec >> 8)
#Else
lEnc = ((lEnc And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lEnc And LNG_POW2_7) <> 0) * &H80000000) _
Xor ((lEnc And &H7FFFFFFF) \ LNG_POW2_8 Or -(lEnc < 0) * LNG_POW2_23)
lDec = ((lDec And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lDec And LNG_POW2_7) <> 0) * &H80000000) _
Xor ((lDec And &H7FFFFFFF) \ LNG_POW2_8 Or -(lDec < 0) * LNG_POW2_23)
#End If
uEncTable.Item(lIdx).Item(lX) = lEnc
uDecTable.Item(lIdx).Item(lS) = lDec
Next
If lX2 <> 0 Then
lX = lX Xor lX2
Else
lX = lX Xor 1
End If
lXInv = uThd.Item(lXInv)
If lXInv = 0 Then
lXInv = 1
End If
Loop
End Sub
Private Function pvKeySchedule(baKey() As Byte, uSbox As ArrayByte256, uDecTable As AesTables, uEncKey As ArrayLong60, uDecKey As ArrayLong60) As Long
Dim lIdx As Long
Dim lJdx As Long
Dim lRCon As Long
Dim lKeyLen As Long
Dim lTemp As Long
Dim lA2 As Long
lRCon = 1
lKeyLen = (UBound(baKey) + 1) \ 4
If Not (lKeyLen = 4 Or lKeyLen = 6 Or lKeyLen = 8) Then
Err.Raise vbObjectError, , "Invalid key bit-size for AES (" & lKeyLen * 8 & ")"
End If
Call CopyMemory(uEncKey.Item(0), baKey(0), lKeyLen * 4)
For lIdx = lKeyLen To 4 * lKeyLen + 27
lTemp = uEncKey.Item(lIdx - 1)
'--- sbox
If lIdx Mod lKeyLen = 0 Or lIdx Mod lKeyLen = 4 And lKeyLen = 8 Then
#If HasOperators Then
lTemp = (CLng(uSbox.Item(lTemp >> 24)) << 24) Xor (CLng(uSbox.Item((lTemp >> 16) And 255)) << 16) _
Xor (CLng(uSbox.Item((lTemp >> 8) And 255)) << 8) Xor uSbox.Item(lTemp And 255)
If lIdx Mod lKeyLen = 0 Then
lTemp = (lTemp << 8) Xor (lTemp >> 24) Xor (lRCon << 24)
lRCon = (lRCon << 1) Xor (lRCon >> 7) * 283
End If
#Else
lA2 = uSbox.Item((lTemp And &H7FFFFFFF) \ LNG_POW2_24 Or -(lTemp < 0) * LNG_POW2_7)
lTemp = ((lA2 And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lA2 And LNG_POW2_7) <> 0) * &H80000000) _
Xor uSbox.Item((lTemp And &HFF0000) \ LNG_POW2_16) * LNG_POW2_16 _
Xor uSbox.Item((lTemp And &HFF00&) \ LNG_POW2_8) * LNG_POW2_8 _
Xor uSbox.Item(lTemp And 255)
If lIdx Mod lKeyLen = 0 Then
lTemp = ((lTemp And (LNG_POW2_23 - 1)) * LNG_POW2_8 Or -((lTemp And LNG_POW2_23) <> 0) * &H80000000) _
Xor ((lTemp And &H7FFFFFFF) \ LNG_POW2_24 Or -(lTemp < 0) * LNG_POW2_7) _
Xor ((lRCon And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lRCon And LNG_POW2_7) <> 0) * &H80000000)
lRCon = lRCon * LNG_POW2_1 Xor (lRCon \ LNG_POW2_7) * 283
End If
#End If
End If
uEncKey.Item(lIdx) = uEncKey.Item(lIdx - lKeyLen) Xor lTemp
Next
pvKeySchedule = lIdx
For lJdx = 0 To lIdx - 1
If (lIdx And 3) <> 0 Then
lTemp = uEncKey.Item(lIdx)
Else
lTemp = uEncKey.Item(lIdx - 4)
End If
If lIdx <= 4 Or lJdx < 4 Then
uDecKey.Item(lJdx) = lTemp
Else
#If HasOperators Then
uDecKey.Item(lJdx) = uDecTable.Item(0).Item(uSbox.Item(lTemp >> 24)) _
Xor uDecTable.Item(1).Item(uSbox.Item((lTemp >> 16) And 255)) _
Xor uDecTable.Item(2).Item(uSbox.Item((lTemp >> 8) And 255)) _
Xor uDecTable.Item(3).Item(uSbox.Item(lTemp And 255))
#Else
lA2 = uSbox.Item((lTemp And &H7FFFFFFF) \ LNG_POW2_24 Or -(lTemp < 0) * LNG_POW2_7)
uDecKey.Item(lJdx) = uDecTable.Item(0).Item(lA2) _
Xor uDecTable.Item(1).Item(uSbox.Item((lTemp And &HFF0000) \ LNG_POW2_16)) _
Xor uDecTable.Item(2).Item(uSbox.Item((lTemp And &HFF00&) \ LNG_POW2_8)) _
Xor uDecTable.Item(3).Item(uSbox.Item(lTemp And 255))
#End If
End If
lIdx = lIdx - 1
Next
End Function
Private Function pvCrypt(uInput As ArrayLong4, uOutput As ArrayLong4, ByVal bDecrypt As Boolean, uKey As ArrayLong60, ByVal lKeyLen As Long, _
uT0 As ArrayLong256, uT1 As ArrayLong256, uT2 As ArrayLong256, uT3 As ArrayLong256, uSbox As ArrayByte256) As Boolean
Dim lIdx As Long
Dim lJdx As Long
Dim lKdx As Long
Dim lA As Long
Dim lB As Long
Dim lC As Long
Dim lD As Long
Dim lA2 As Long
Dim lB2 As Long
Dim lC2 As Long
'--- first round
lA = uInput.Item(0) Xor uKey.Item(0)
lB = uInput.Item(1 - bDecrypt * 2) Xor uKey.Item(1)
lC = uInput.Item(2) Xor uKey.Item(2)
lD = uInput.Item(3 + bDecrypt * 2) Xor uKey.Item(3)
'--- inner rounds
lKdx = 4
For lIdx = 0 To lKeyLen \ 4 - 3
#If HasOperators Then
lA2 = uT0.Item(lA >> 24) Xor uT1.Item((lB >> 16) And 255) Xor uT2.Item((lC >> 8) And 255) Xor uT3.Item(lD And 255) Xor uKey.Item(lKdx + 0)
lB2 = uT0.Item(lB >> 24) Xor uT1.Item((lC >> 16) And 255) Xor uT2.Item((lD >> 8) And 255) Xor uT3.Item(lA And 255) Xor uKey.Item(lKdx + 1)
lC2 = uT0.Item(lC >> 24) Xor uT1.Item((lD >> 16) And 255) Xor uT2.Item((lA >> 8) And 255) Xor uT3.Item(lB And 255) Xor uKey.Item(lKdx + 2)
lD = uT0.Item(lD >> 24) Xor uT1.Item((lA >> 16) And 255) Xor uT2.Item((lB >> 8) And 255) Xor uT3.Item(lC And 255) Xor uKey.Item(lKdx + 3)
#Else
lA2 = uT0.Item((lA And &H7F000000) \ LNG_POW2_24 Or -(lA < 0) * LNG_POW2_7) _
Xor uT1.Item((lB And &HFF0000) \ LNG_POW2_16) _
Xor uT2.Item((lC And &HFF00&) \ LNG_POW2_8) _
Xor uT3.Item(lD And 255) Xor uKey.Item(lKdx + 0)
lB2 = uT0.Item((lB And &H7F000000) \ LNG_POW2_24 Or -(lB < 0) * LNG_POW2_7) _
Xor uT1.Item((lC And &HFF0000) \ LNG_POW2_16) _
Xor uT2.Item((lD And &HFF00&) \ LNG_POW2_8) _
Xor uT3.Item(lA And 255) Xor uKey.Item(lKdx + 1)
lC2 = uT0.Item((lC And &H7F000000) \ LNG_POW2_24 Or -(lC < 0) * LNG_POW2_7) _
Xor uT1.Item((lD And &HFF0000) \ LNG_POW2_16) _
Xor uT2.Item((lA And &HFF00&) \ LNG_POW2_8) _
Xor uT3.Item(lB And 255) Xor uKey.Item(lKdx + 2)
lD = uT0.Item((lD And &H7F000000) \ LNG_POW2_24 Or -(lD < 0) * LNG_POW2_7) _
Xor uT1.Item((lA And &HFF0000) \ LNG_POW2_16) _
Xor uT2.Item((lB And &HFF00&) \ LNG_POW2_8) _
Xor uT3.Item(lC And 255) Xor uKey.Item(lKdx + 3)
#End If
lKdx = lKdx + 4
lA = lA2: lB = lB2: lC = lC2
Next
'--- last round
For lIdx = 0 To 3
If bDecrypt Then
lJdx = -lIdx And 3
Else
lJdx = lIdx
End If
#If HasOperators Then
uOutput.Item(lJdx) = (CLng(uSbox.Item((lA >> 24) And 255)) << 24) _
Xor (CLng(uSbox.Item((lB >> 16) And 255)) << 16) _
Xor (CLng(uSbox.Item((lC >> 8) And 255)) << 8) _
Xor uSbox.Item(lD And 255) Xor uKey.Item(lKdx)
#Else
lA2 = uSbox.Item((lA And &H7F000000) \ LNG_POW2_24 Or -(lA < 0) * LNG_POW2_7)
uOutput.Item(lJdx) = ((lA2 And (LNG_POW2_7 - 1)) * LNG_POW2_24 Or -((lA2 And LNG_POW2_7) <> 0) * &H80000000) _
Xor uSbox.Item((lB And &HFF0000) \ LNG_POW2_16) * LNG_POW2_16 _
Xor uSbox.Item((lC And &HFF00&) \ LNG_POW2_8) * LNG_POW2_8 _
Xor uSbox.Item(lD And 255) Xor uKey.Item(lKdx)
#End If
lKdx = lKdx + 1
lA2 = lA: lA = lB: lB = lC: lC = lD: lD = lA2
Next
'--- success
pvCrypt = True
End Function
Private Function pvProcess(uCtx As CryptoAesContext, ByVal bEncrypt As Boolean, uInput As ArrayLong4, uOutput As ArrayLong4) As Long
If bEncrypt Then
pvProcess = pvCrypt(uInput, uOutput, False, uCtx.EncKey, uCtx.KeyLen, m_uEncTables.Item(0), m_uEncTables.Item(1), m_uEncTables.Item(2), m_uEncTables.Item(3), m_uSbox)
Else
pvProcess = pvCrypt(uInput, uOutput, True, uCtx.DecKey, uCtx.KeyLen, m_uDecTables.Item(0), m_uDecTables.Item(1), m_uDecTables.Item(2), m_uDecTables.Item(3), m_uSboxInv)
End If
End Function
Public Sub CryptoAesInit(uCtx As CryptoAesContext, baKey() As Byte, Optional Nonce As Variant)
Dim baNonce() As Byte
If m_uSbox.Item(0) = 0 Then
pvInit m_uEncTables, m_uDecTables, m_uSbox, m_uSboxInv
End If
With uCtx
.KeyLen = pvKeySchedule(baKey, m_uSbox, m_uDecTables, .EncKey, .DecKey)
If IsMissing(Nonce) Then
baNonce = vbNullString
Else
baNonce = Nonce
End If
ReDim Preserve baNonce(0 To LNG_BLOCKSZ - 1) As Byte
Call CopyMemory(.Nonce, baNonce(0), LNG_BLOCKSZ)
End With
End Sub
Public Function CryptoAesProcess(uCtx As CryptoAesContext, ByVal Encrypt As Boolean, baBlock() As Byte, Optional ByVal Pos As Long) As Boolean
Dim uBlock As ArrayLong4
Debug.Assert UBound(baBlock) + 1 >= Pos + LNG_BLOCKSZ
#If HasOperators Then
CryptoAesProcess = pvProcess(uCtx, Encrypt, VarPtr(baBlock(Pos)), VarPtr(baBlock(Pos)))
#Else
Call CopyMemory(uBlock, baBlock(Pos), LNG_BLOCKSZ)
CryptoAesProcess = pvProcess(uCtx, Encrypt, uBlock, uBlock)
Call CopyMemory(baBlock(Pos), uBlock, LNG_BLOCKSZ)
#End If
End Function
Public Function CryptoAesCbcEncrypt(uCtx As CryptoAesContext, baBuffer() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1, Optional ByVal Final As Boolean = True) As Boolean
Dim lIdx As Long
Dim lNumBlocks As Long
Dim uNonce As ArrayLong4
Dim uBlock As ArrayLong4
Dim lPad As Long
If Size < 0 Then
Size = UBound(baBuffer) + 1 - Pos
End If
If Final Then
lNumBlocks = Size \ LNG_BLOCKSZ
Else
If Size Mod LNG_BLOCKSZ <> 0 Then
Err.Raise vbObjectError, , "Invalid non-final block size for CBC mode (" & Size Mod LNG_BLOCKSZ & ")"
End If
lNumBlocks = Size \ LNG_BLOCKSZ - 1
End If
uNonce = uCtx.Nonce
For lIdx = 0 To lNumBlocks
If lIdx = lNumBlocks And Final Then
'--- append PKCS#5 padding
lPad = (LNG_BLOCKSZ - Size Mod LNG_BLOCKSZ) * &H1010101
uBlock.Item(0) = lPad: uBlock.Item(1) = lPad: uBlock.Item(2) = lPad: uBlock.Item(3) = lPad
If Size - Pos > 0 Then
Call CopyMemory(uBlock, baBuffer(Pos), Size - Pos)
End If
ReDim Preserve baBuffer(0 To Pos + LNG_BLOCKSZ - 1) As Byte
Else
Call CopyMemory(uBlock, baBuffer(Pos), LNG_BLOCKSZ)
End If
uNonce.Item(0) = uNonce.Item(0) Xor uBlock.Item(0)
uNonce.Item(1) = uNonce.Item(1) Xor uBlock.Item(1)
uNonce.Item(2) = uNonce.Item(2) Xor uBlock.Item(2)
uNonce.Item(3) = uNonce.Item(3) Xor uBlock.Item(3)
pvProcess uCtx, True, uNonce, uNonce
Call CopyMemory(baBuffer(Pos), uNonce, LNG_BLOCKSZ)
Pos = Pos + LNG_BLOCKSZ
Next
If Not Final Then
uCtx.Nonce = uNonce
End If
'--- success
CryptoAesCbcEncrypt = True
End Function
Public Function CryptoAesCbcDecrypt(uCtx As CryptoAesContext, baBuffer() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1, Optional ByVal Final As Boolean = True) As Boolean
Dim lIdx As Long
Dim lNumBlocks As Long
Dim uInput As ArrayLong4
Dim uNonce As ArrayLong4
Dim uBlock As ArrayLong4
Dim lPad As Long
Dim lJdx As Long
If Size < 0 Then
Size = UBound(baBuffer) + 1 - Pos
End If
If Size Mod LNG_BLOCKSZ <> 0 Then
Err.Raise vbObjectError, , "Invalid partial block size for CBC mode (" & Size Mod LNG_BLOCKSZ & ")"
End If
lNumBlocks = Size \ LNG_BLOCKSZ - 1
uNonce = uCtx.Nonce
For lIdx = 0 To lNumBlocks
Call CopyMemory(uInput, baBuffer(Pos), LNG_BLOCKSZ)
pvProcess uCtx, False, uInput, uBlock
uBlock.Item(0) = uBlock.Item(0) Xor uNonce.Item(0)
uBlock.Item(1) = uBlock.Item(1) Xor uNonce.Item(1)
uBlock.Item(2) = uBlock.Item(2) Xor uNonce.Item(2)
uBlock.Item(3) = uBlock.Item(3) Xor uNonce.Item(3)
Call CopyMemory(baBuffer(Pos), uBlock, LNG_BLOCKSZ)
If lIdx = lNumBlocks And Final Then
'--- check PKCS#5 padding
lPad = baBuffer(Pos + LNG_BLOCKSZ - 1)
If lPad = 0 Or lPad > LNG_BLOCKSZ Then
Exit Function
End If
For lJdx = 1 To lPad
If baBuffer(Pos + LNG_BLOCKSZ - lJdx) <> lPad Then
Exit Function
End If
Next
ReDim Preserve baBuffer(0 To Pos + LNG_BLOCKSZ - lPad - 1) As Byte
Else
uNonce = uInput
Pos = Pos + LNG_BLOCKSZ
End If
Next
If Not Final Then
uCtx.Nonce = uNonce
End If
'--- success
CryptoAesCbcDecrypt = True
End Function</wqw>