AES(RijnDael) cryptographic algorithm, did someone write it?

newbie · Post by **newbie** » Wed Aug 06, 2003 1:40 pm

Hi,

I found C++ and VB source code, but not PB.
I tried to convert VB sources code (that i already do for one of my own VB app) but i failed because i didn't know how to convert some VB syntaxe.

Sorry for the huge Copy/Paste :

VB source code:
-------------------

'*******************************************************************************
' MODULE: CRijndael
' FILENAME: CRijndael.cls
' AUTHOR: Phil Fresle
' CREATED: 16-Feb-2001
' COPYRIGHT: Copyright 2001 Phil Fresle
' EMAIL: phil@frez.co.uk
' WEB: http://www.frez.co.uk
'
' DESCRIPTION:
' Implementation of the AES Rijndael Block Cipher. Inspired by Mike Scott's
' implementation in C. Permission for free direct or derivative use is granted
' subject to compliance with any conditions that the originators of the
' algorithm place on its exploitation.
'
' MODIFICATION HISTORY:
' 16-Feb-2001 Phil Fresle Initial Version
' 03-Apr-2001 Phil Fresle Added EncryptData and DecryptData functions to
' make it easier to use by VB developers for
' encrypting and decrypting strings. These procs
' take large byte arrays, the resultant encoded
' data includes the message length inserted on
' the front four bytes prior to encryption.
' 19-Apr-2001 Phil Fresle Thanks to Paolo Migliaccio for finding a bug
' with 256 bit key. Problem was in the gkey
' function. Now properly matches NIST values.
'*******************************************************************************
Option Explicit

Private m_lOnBits(30) As Long
Private m_l2Power(30) As Long
Private m_bytOnBits(7) As Byte
Private m_byt2Power(7) As Byte

Private m_InCo(3) As Byte

Private m_fbsub(255) As Byte
Private m_rbsub(255) As Byte
Private m_ptab(255) As Byte
Private m_ltab(255) As Byte
Private m_ftable(255) As Long
Private m_rtable(255) As Long
Private m_rco(29) As Long

Private m_Nk As Long
Private m_Nb As Long
Private m_Nr As Long
Private m_fi(23) As Byte
Private m_ri(23) As Byte
Private m_fkey(119) As Long
Private m_rkey(119) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)

'*******************************************************************************
' Class_Initialize (SUB)
'*******************************************************************************
Private Sub Class_Initialize()
m_InCo(0) = &HB
m_InCo(1) = &HD
m_InCo(2) = &H9
m_InCo(3) = &HE

' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - BITS SET FROM RIGHT
m_bytOnBits(0) = 1 ' 00000001
m_bytOnBits(1) = 3 ' 00000011
m_bytOnBits(2) = 7 ' 00000111
m_bytOnBits(3) = 15 ' 00001111
m_bytOnBits(4) = 31 ' 00011111
m_bytOnBits(5) = 63 ' 00111111
m_bytOnBits(6) = 127 ' 01111111
m_bytOnBits(7) = 255 ' 11111111

' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - POWERS OF 2
m_byt2Power(0) = 1 ' 00000001
m_byt2Power(1) = 2 ' 00000010
m_byt2Power(2) = 4 ' 00000100
m_byt2Power(3) = 8 ' 00001000
m_byt2Power(4) = 16 ' 00010000
m_byt2Power(5) = 32 ' 00100000
m_byt2Power(6) = 64 ' 01000000
m_byt2Power(7) = 128 ' 10000000

' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - BITS SET FROM RIGHT
m_lOnBits(0) = 1 ' 00000000000000000000000000000001
m_lOnBits(1) = 3 ' 00000000000000000000000000000011
m_lOnBits(2) = 7 ' 00000000000000000000000000000111
m_lOnBits(3) = 15 ' 00000000000000000000000000001111
m_lOnBits(4) = 31 ' 00000000000000000000000000011111
m_lOnBits(5) = 63 ' 00000000000000000000000000111111
m_lOnBits(6) = 127 ' 00000000000000000000000001111111
m_lOnBits(7) = 255 ' 00000000000000000000000011111111
m_lOnBits(8) = 511 ' 00000000000000000000000111111111
m_lOnBits(9) = 1023 ' 00000000000000000000001111111111
m_lOnBits(10) = 2047 ' 00000000000000000000011111111111
m_lOnBits(11) = 4095 ' 00000000000000000000111111111111
m_lOnBits(12) = 8191 ' 00000000000000000001111111111111
m_lOnBits(13) = 16383 ' 00000000000000000011111111111111
m_lOnBits(14) = 32767 ' 00000000000000000111111111111111
m_lOnBits(15) = 65535 ' 00000000000000001111111111111111
m_lOnBits(16) = 131071 ' 00000000000000011111111111111111
m_lOnBits(17) = 262143 ' 00000000000000111111111111111111
m_lOnBits(18) = 524287 ' 00000000000001111111111111111111
m_lOnBits(19) = 1048575 ' 00000000000011111111111111111111
m_lOnBits(20) = 2097151 ' 00000000000111111111111111111111
m_lOnBits(21) = 4194303 ' 00000000001111111111111111111111
m_lOnBits(22) = 8388607 ' 00000000011111111111111111111111
m_lOnBits(23) = 16777215 ' 00000000111111111111111111111111
m_lOnBits(24) = 33554431 ' 00000001111111111111111111111111
m_lOnBits(25) = 67108863 ' 00000011111111111111111111111111
m_lOnBits(26) = 134217727 ' 00000111111111111111111111111111
m_lOnBits(27) = 268435455 ' 00001111111111111111111111111111
m_lOnBits(28) = 536870911 ' 00011111111111111111111111111111
m_lOnBits(29) = 1073741823 ' 00111111111111111111111111111111
m_lOnBits(30) = 2147483647 ' 01111111111111111111111111111111

' Could have done this with a loop calculating each value, but simply
' assigning the values is quicker - POWERS OF 2
m_l2Power(0) = 1 ' 00000000000000000000000000000001
m_l2Power(1) = 2 ' 00000000000000000000000000000010
m_l2Power(2) = 4 ' 00000000000000000000000000000100
m_l2Power(3) = 8 ' 00000000000000000000000000001000
m_l2Power(4) = 16 ' 00000000000000000000000000010000
m_l2Power(5) = 32 ' 00000000000000000000000000100000
m_l2Power(6) = 64 ' 00000000000000000000000001000000
m_l2Power(7) = 128 ' 00000000000000000000000010000000
m_l2Power(8) = 256 ' 00000000000000000000000100000000
m_l2Power(9) = 512 ' 00000000000000000000001000000000
m_l2Power(10) = 1024 ' 00000000000000000000010000000000
m_l2Power(11) = 2048 ' 00000000000000000000100000000000
m_l2Power(12) = 4096 ' 00000000000000000001000000000000
m_l2Power(13) = 8192 ' 00000000000000000010000000000000
m_l2Power(14) = 16384 ' 00000000000000000100000000000000
m_l2Power(15) = 32768 ' 00000000000000001000000000000000
m_l2Power(16) = 65536 ' 00000000000000010000000000000000
m_l2Power(17) = 131072 ' 00000000000000100000000000000000
m_l2Power(18) = 262144 ' 00000000000001000000000000000000
m_l2Power(19) = 524288 ' 00000000000010000000000000000000
m_l2Power(20) = 1048576 ' 00000000000100000000000000000000
m_l2Power(21) = 2097152 ' 00000000001000000000000000000000
m_l2Power(22) = 4194304 ' 00000000010000000000000000000000
m_l2Power(23) = 8388608 ' 00000000100000000000000000000000
m_l2Power(24) = 16777216 ' 00000001000000000000000000000000
m_l2Power(25) = 33554432 ' 00000010000000000000000000000000
m_l2Power(26) = 67108864 ' 00000100000000000000000000000000
m_l2Power(27) = 134217728 ' 00001000000000000000000000000000
m_l2Power(28) = 268435456 ' 00010000000000000000000000000000
m_l2Power(29) = 536870912 ' 00100000000000000000000000000000
m_l2Power(30) = 1073741824 ' 01000000000000000000000000000000
End Sub

'*******************************************************************************
' LShift (FUNCTION)
'*******************************************************************************
Private Function LShift(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If

If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
m_l2Power(iShiftBits))
End If
End Function

'*******************************************************************************
' RShift (FUNCTION)
'*******************************************************************************
Private Function RShift(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If

RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function

'*******************************************************************************
' LShiftByte (FUNCTION)
'*******************************************************************************
Private Function LShiftByte(ByVal bytValue As Byte, _
ByVal bytShiftBits As Byte) As Byte
If bytShiftBits = 0 Then
LShiftByte = bytValue
Exit Function
ElseIf bytShiftBits = 7 Then
If bytValue And 1 Then
LShiftByte = &H80
Else
LShiftByte = 0
End If
Exit Function
ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
Err.Raise 6
End If

LShiftByte = ((bytValue And m_bytOnBits(7 - bytShiftBits)) * _
m_byt2Power(bytShiftBits))
End Function

'*******************************************************************************
' RShiftByte (FUNCTION)
'*******************************************************************************
Private Function RShiftByte(ByVal bytValue As Byte, _
ByVal bytShiftBits As Byte) As Byte
If bytShiftBits = 0 Then
RShiftByte = bytValue
Exit Function
ElseIf bytShiftBits = 7 Then
If bytValue And &H80 Then
RShiftByte = 1
Else
RShiftByte = 0
End If
Exit Function
ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
Err.Raise 6
End If

RShiftByte = bytValue \ m_byt2Power(bytShiftBits)
End Function

'*******************************************************************************
' RotateLeft (FUNCTION)
'*******************************************************************************
Private Function RotateLeft(ByVal lValue As Long, _
ByVal iShiftBits As Integer) As Long
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

''*******************************************************************************
'' RotateLeftByte (FUNCTION)
'*******************************************************************************
Private Function RotateLeftByte(ByVal bytValue As Byte, _
ByVal bytShiftBits As Byte) As Byte
RotateLeftByte = LShiftByte(bytValue, bytShiftBits) Or _
RShiftByte(bytValue, (8 - bytShiftBits))
End Function

'*******************************************************************************
' Pack (FUNCTION)
'*******************************************************************************
Private Function Pack(b() As Byte) As Long
Dim lCount As Long
Dim lTemp As Long

For lCount = 0 To 3
lTemp = b(lCount)
Pack = Pack Or LShift(lTemp, (lCount * 8))
Next
End Function

'*******************************************************************************
' PackFrom (FUNCTION)
'*******************************************************************************
Private Function PackFrom(b() As Byte, _
ByVal k As Long) As Long
Dim lCount As Long
Dim lTemp As Long

For lCount = 0 To 3
lTemp = b(lCount + k)
PackFrom = PackFrom Or LShift(lTemp, (lCount * 8))
Next
End Function

'*******************************************************************************
' Unpack (SUB)
'*******************************************************************************
Private Sub Unpack(ByVal a As Long, _
b() As Byte)
b(0) = a And m_lOnBits(7)
b(1) = RShift(a, 8) And m_lOnBits(7)
b(2) = RShift(a, 16) And m_lOnBits(7)
b(3) = RShift(a, 24) And m_lOnBits(7)
End Sub

'*******************************************************************************
' UnpackFrom (SUB)
'*******************************************************************************
Private Sub UnpackFrom(ByVal a As Long, _
b() As Byte, _
ByVal k As Long)
b(0 + k) = a And m_lOnBits(7)
b(1 + k) = RShift(a, 8) And m_lOnBits(7)
b(2 + k) = RShift(a, 16) And m_lOnBits(7)
b(3 + k) = RShift(a, 24) And m_lOnBits(7)
End Sub

'*******************************************************************************
' xtime (FUNCTION)
'*******************************************************************************
Private Function xtime(ByVal a As Byte) As Byte
Dim b As Byte

If (a And &H80) Then
b = &H1B
Else
b = 0
End If

a = LShiftByte(a, 1)
a = a Xor b

xtime = a
End Function

'*******************************************************************************
' bmul (FUNCTION)
'*******************************************************************************
Private Function bmul(ByVal x As Byte, _
y As Byte) As Byte
If x <> 0 And y <> 0 Then
bmul = m_ptab((CLng(m_ltab(x)) + CLng(m_ltab(y))) Mod 255)
Else
bmul = 0
End If
End Function

'*******************************************************************************
' SubByte (FUNCTION)
'*******************************************************************************
Private Function SubByte(ByVal a As Long) As Long
Dim b(3) As Byte

Unpack a, b
b(0) = m_fbsub(b(0))
b(1) = m_fbsub(b(1))
b(2) = m_fbsub(b(2))
b(3) = m_fbsub(b(3))

SubByte = Pack(b)
End Function

'*******************************************************************************
' product (FUNCTION)
'*******************************************************************************
Private Function product(ByVal x As Long, _
ByVal y As Long) As Long
Dim xb(3) As Byte
Dim yb(3) As Byte

Unpack x, xb
Unpack y, yb
product = bmul(xb(0), yb(0)) Xor bmul(xb(1), yb(1)) Xor bmul(xb(2), yb(2)) _
Xor bmul(xb(3), yb(3))
End Function

'*******************************************************************************
' InvMixCol (FUNCTION)
'*******************************************************************************
Private Function InvMixCol(ByVal x As Long) As Long
Dim y As Long
Dim m As Long
Dim b(3) As Byte

m = Pack(m_InCo)
b(3) = product(m, x)
m = RotateLeft(m, 24)
b(2) = product(m, x)
m = RotateLeft(m, 24)
b(1) = product(m, x)
m = RotateLeft(m, 24)
b(0) = product(m, x)
y = Pack(b)

InvMixCol = y
End Function

'*******************************************************************************
' ByteSub (FUNCTION)
'*******************************************************************************
Private Function ByteSub(ByVal x As Byte) As Byte
Dim y As Byte

y = m_ptab(255 - m_ltab(x))
x = y
x = RotateLeftByte(x, 1)
y = y Xor x
x = RotateLeftByte(x, 1)
y = y Xor x
x = RotateLeftByte(x, 1)
y = y Xor x
x = RotateLeftByte(x, 1)
y = y Xor x
y = y Xor &H63

ByteSub = y
End Function

'*******************************************************************************
' gentables (SUB)
'*******************************************************************************
Public Sub gentables()
Dim i As Long
Dim y As Byte
Dim b(3) As Byte
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

May be someone is skilled enought and interested to convert it for PB users ?
( i had problems with "&HB" and "Exit Function", and others...)

Karbon · Post by **Karbon** » Wed Aug 06, 2003 1:42 pm

I'm doing up Blowfish in PB - though it probably won't be done for some time (few weeks).. I'll make the code public once it's finished..

newbie · Post by **newbie** » Wed Aug 06, 2003 1:49 pm

Thanks you Karbon to share your work

Blowfish is good too, and have AES in addition would be very nice

Karbon · Post by **Karbon** » Wed Aug 06, 2003 1:50 pm

I might take a stab at that too when I get to that in this project.. Strong crypto is goooooooooooood!

newbie · Post by **newbie** » Wed Aug 06, 2003 1:57 pm

Indeed !

I don't know exactly for blowfish, but about AES it would take 149 trillion (149 thousand-billion ) years to decrypt, by brute force by a comp able to break DES in one second (!), a AES 128 bits key encrypted text

I know Blowfish is a good one too, to have many cryptographic solutions would be so nice ^^

Karbon · Post by **Karbon** » Wed Aug 06, 2003 2:14 pm

AES is nice for sure.. I've adopted Blofish as my favorite for a lot of reasons.. If anyone is interested there is a decent page I just found it overviewing Blowfish : http://www.counterpane.com/blowfish.html

Lots of source code there too..

Leo · Post by **Leo** » Thu Aug 07, 2003 1:31 pm

You can also use the CryptoSys DLL. It free to download from http://www.di-mgt.com.au/crypto.html (for personal use). Supported algorithms are DES, AES, Blowfish etc. And soon PKI/RSA. A simple code example :

Code: Select all

Input$="0300000000000000"
Output$="0000000000000000"
Key$="0000000000000070"
If OpenLibrary(10, "dicryptosys.dll")
  R.l=CallFunction(10, "DES_Hex",@Output$,@Input$,@Key$,0) 
  If R.l=0
    MessageRequester("Information", "Encrypt : "+Output$, 0)
  Else
    MessageRequester("Information", "Error : "+Str(R.l), 0)
  EndIf
  R.l=CallFunction(10, "DES_Hex",@Input$,@Output$,@Key$,1) 
  If R.l=0
    MessageRequester("Information", "Decrypt : "+Input$, 0)
  Else
    MessageRequester("Information", "Error : "+Str(R.l), 0)
  EndIf
Else
  MessageRequester("Information", "Could not open dicrypto.dll", 0)
EndIf

Success

Leo

Karbon · Post by **Karbon** » Thu Aug 07, 2003 4:27 pm

Wow. Finally a decent priced library with a developers license! woohoo!

$59 isn't that bad at all. I might grab that up instead of writing it in PB!

newbie · Post by **newbie** » Thu Aug 07, 2003 6:22 pm

i don't want to pay for something which has his source code available... because i can code it, in taking time. In addition i'm sure a day to see all this feature in PB, not in built in command, but at least dev by PB users...

Shannara · Post by **Shannara** » Wed Nov 05, 2003 5:22 pm

Any update on this? I have the exact same code and tried to convert it last night, without much luck.. lol. And I agree. The whole reason for me to use PB over VB is due to speed, size, and NO DEPENDENCIES. Such as runtime libraries and external libraries.. grr such as DLLs....

FYI: your missing half the algo. There is a bas file needed to encrypt and decrypt strings with this.

Paul Dwyer · Post by **Paul Dwyer** » Thu Nov 06, 2003 2:20 am

Try this

http://www.pbcrypto.com/pbcrypto.php

Different flavour of PB but shouldn't need too much tweaking to get working in this PB

Shannara · Post by **Shannara** » Mon Nov 10, 2003 8:06 am

Ok, since nobody took up this much needed task, and since I am from a VB background and not a PowerBasic background, I have converted the following from VB code (posted on this thread) to PB. However, there are some things I could not convert cus.. well, I'm a PB newbie

They are marked as ;CONVERT:

Anyways, the code is what I have so far, if anybody can help.. I'll keep on plugging away as best as I can

Code: Select all

;******************************************************************************* 
; MODULE: CRijndael 
; FILENAME: CRijndael.cls 
; AUTHOR: Phil Fresle 
; CREATED: 16-Feb-2001 
; COPYRIGHT: COPYRIGHT 2001 Phil Fresle 
; EMAIL: phil@frez.co.uk 
; WEB: http://www.frez.co.uk 
; 
; DESCRIPTION: 
; Implementation of the AES Rijndael Block Cipher. Inspired by Mike Scott's 
; implementation in C. Permission For free direct Or derivative use is granted 
; subject To compliance with Any conditions that the originators of the 
; algorithm place On its exploitation. 
; 
; MODIFICATION HISTORY: 
; 16-Feb-2001 Phil Fresle Initial Version 
; 03-Apr-2001 Phil Fresle Added EncryptData And DecryptData functions To 
; make it easier To use by VB developers For 
; encrypting And decrypting strings. These procs 
; take large Byte arrays, the resultant encoded 
; Data includes the message Length inserted On 
; the front four bytes prior To encryption. 
; 19-Apr-2001 Phil Fresle Thanks To Paolo Migliaccio For finding a bug 
; with 256 bit KEY. Problem was in the gkey 
; Function. Now properly matches NIST values. 
;******************************************************************************* 
;Option Explicit 

m_lOnBits(30).l 
m_l2Power(30).l 
m_bytOnBits(7).b 
m_byt2Power(7).b 

m_InCo(3).b

m_fbsub(255).b 
m_rbsub(255).b 
m_ptab(255).b 
m_ltab(255).b 
m_ftable(255).l 
m_rtable(255).l 
m_rco(29).l

m_Nk.l 
m_Nb.l 
m_Nr.l 
m_fi(23).b 
m_ri(23).b 
m_fkey(119).l 
m_rkey(119).l 

;CONVERT: Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long) 

;******************************************************************************* 
; Class_Initialize (Sub) 
;******************************************************************************* 
Procedure Class_Initialize() 
m_InCo(0) = &HB 
m_InCo(1) = &HD 
m_InCo(2) = &H9 
m_InCo(3) = &HE 

; Could have done this with a Loop calculating each value, but simply 
; assigning the values is quicker - BITS SET FROM RIGHT 
m_bytOnBits(0) = 1 ; 00000001 
m_bytOnBits(1) = 3 ; 00000011 
m_bytOnBits(2) = 7 ; 00000111 
m_bytOnBits(3) = 15 ; 00001111 
m_bytOnBits(4) = 31 ; 00011111 
m_bytOnBits(5) = 63 ; 00111111 
m_bytOnBits(6) = 127 ; 01111111 
m_bytOnBits(7) = 255 ; 11111111 

; Could have done this with a Loop calculating each value, but simply 
; assigning the values is quicker - POWERS OF 2 
m_byt2Power(0) = 1 ; 00000001 
m_byt2Power(1) = 2 ; 00000010 
m_byt2Power(2) = 4 ; 00000100 
m_byt2Power(3) = 8 ; 00001000 
m_byt2Power(4) = 16 ; 00010000 
m_byt2Power(5) = 32 ; 00100000 
m_byt2Power(6) = 64 ; 01000000 
m_byt2Power(7) = 128 ; 10000000 

; Could have done this with a Loop calculating each value, but simply 
; assigning the values is quicker - BITS SET FROM RIGHT 
m_lOnBits(0) = 1 ; 00000000000000000000000000000001 
m_lOnBits(1) = 3 ; 00000000000000000000000000000011 
m_lOnBits(2) = 7 ; 00000000000000000000000000000111 
m_lOnBits(3) = 15 ; 00000000000000000000000000001111 
m_lOnBits(4) = 31 ; 00000000000000000000000000011111 
m_lOnBits(5) = 63 ; 00000000000000000000000000111111 
m_lOnBits(6) = 127 ; 00000000000000000000000001111111 
m_lOnBits(7) = 255 ; 00000000000000000000000011111111 
m_lOnBits(8) = 511 ; 00000000000000000000000111111111 
m_lOnBits(9) = 1023 ; 00000000000000000000001111111111 
m_lOnBits(10) = 2047 ; 00000000000000000000011111111111 
m_lOnBits(11) = 4095 ; 00000000000000000000111111111111 
m_lOnBits(12) = 8191 ; 00000000000000000001111111111111 
m_lOnBits(13) = 16383 ; 00000000000000000011111111111111 
m_lOnBits(14) = 32767 ; 00000000000000000111111111111111 
m_lOnBits(15) = 65535 ; 00000000000000001111111111111111 
m_lOnBits(16) = 131071 ; 00000000000000011111111111111111 
m_lOnBits(17) = 262143 ; 00000000000000111111111111111111 
m_lOnBits(18) = 524287 ; 00000000000001111111111111111111 
m_lOnBits(19) = 1048575 ; 00000000000011111111111111111111 
m_lOnBits(20) = 2097151 ; 00000000000111111111111111111111 
m_lOnBits(21) = 4194303 ; 00000000001111111111111111111111 
m_lOnBits(22) = 8388607 ; 00000000011111111111111111111111 
m_lOnBits(23) = 16777215 ; 00000000111111111111111111111111 
m_lOnBits(24) = 33554431 ; 00000001111111111111111111111111 
m_lOnBits(25) = 67108863 ; 00000011111111111111111111111111 
m_lOnBits(26) = 134217727 ; 00000111111111111111111111111111 
m_lOnBits(27) = 268435455 ; 00001111111111111111111111111111 
m_lOnBits(28) = 536870911 ; 00011111111111111111111111111111 
m_lOnBits(29) = 1073741823 ; 00111111111111111111111111111111 
m_lOnBits(30) = 2147483647 ; 01111111111111111111111111111111 

; Could have done this with a Loop calculating each value, but simply 
; assigning the values is quicker - POWERS OF 2 
m_l2Power(0) = 1 ; 00000000000000000000000000000001 
m_l2Power(1) = 2 ; 00000000000000000000000000000010 
m_l2Power(2) = 4 ; 00000000000000000000000000000100 
m_l2Power(3) = 8 ; 00000000000000000000000000001000 
m_l2Power(4) = 16 ; 00000000000000000000000000010000 
m_l2Power(5) = 32 ; 00000000000000000000000000100000 
m_l2Power(6) = 64 ; 00000000000000000000000001000000 
m_l2Power(7) = 128 ; 00000000000000000000000010000000 
m_l2Power(8) = 256 ; 00000000000000000000000100000000 
m_l2Power(9) = 512 ; 00000000000000000000001000000000 
m_l2Power(10) = 1024 ; 00000000000000000000010000000000 
m_l2Power(11) = 2048 ; 00000000000000000000100000000000 
m_l2Power(12) = 4096 ; 00000000000000000001000000000000 
m_l2Power(13) = 8192 ; 00000000000000000010000000000000 
m_l2Power(14) = 16384 ; 00000000000000000100000000000000 
m_l2Power(15) = 32768 ; 00000000000000001000000000000000 
m_l2Power(16) = 65536 ; 00000000000000010000000000000000 
m_l2Power(17) = 131072 ; 00000000000000100000000000000000 
m_l2Power(18) = 262144 ; 00000000000001000000000000000000 
m_l2Power(19) = 524288 ; 00000000000010000000000000000000 
m_l2Power(20) = 1048576 ; 00000000000100000000000000000000 
m_l2Power(21) = 2097152 ; 00000000001000000000000000000000 
m_l2Power(22) = 4194304 ; 00000000010000000000000000000000 
m_l2Power(23) = 8388608 ; 00000000100000000000000000000000 
m_l2Power(24) = 16777216 ; 00000001000000000000000000000000 
m_l2Power(25) = 33554432 ; 00000010000000000000000000000000 
m_l2Power(26) = 67108864 ; 00000100000000000000000000000000 
m_l2Power(27) = 134217728 ; 00001000000000000000000000000000 
m_l2Power(28) = 268435456 ; 00010000000000000000000000000000 
m_l2Power(29) = 536870912 ; 00100000000000000000000000000000 
m_l2Power(30) = 1073741824 ; 01000000000000000000000000000000 
EndProcedure 

;******************************************************************************* 
; LShift (Function) 
;******************************************************************************* 
Procedure LShift.l(lValue.l, iShiftBits.w) 
If iShiftBits = 0 Then 
  ProcedureReturn lValue 
ElseIf iShiftBits = 31 Then 
  If lValue And 1 Then 
    ProcedureReturn &H80000000 
  Else 
      ProcedureReturn 0
  End If 
  ;CONVERT: Exit Function 
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
  ;CONVERT: Err.Raise 6 
End If 
        
If (lValue And m_l2Power(31 - iShiftBits)) Then 
  ProcedureReturn ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _ 
  m_l2Power(iShiftBits)) Or &H80000000 
Else 
  ProcedureReturn = ((lValue And m_lOnBits(31 - iShiftBits)) * _ 
  m_l2Power(iShiftBits)) 
End If 
EndProcedure
            
;******************************************************************************* 
; RShift (Function) 
;******************************************************************************* 
Procedure RShift.l(lValue.l, iShiftBits.w) 
If iShiftBits = 0 Then 
  ProcedureReturn lValue 
  ;CONVERT: Exit Function 
ElseIf iShiftBits = 31 Then 
  If lValue And &H80000000 Then 
    ProcedureReturn 1 
  Else 
    ProcedureReturn 0 
  End If 
  ;CONVERT: Exit Function 
  ElseIf iShiftBits < 0 Or iShiftBits > 31 Then 
    ;CONVERT: Err.Raise 6 
End If 
ProcedureReturn (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits) 
If (lValue And &H80000000) Then 
  ;CONVERT: RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1))) 
End If 
EndProcedure 

;******************************************************************************* 
; LShiftByte (Function) 
;******************************************************************************* 
Procedure LShiftByte.b(bytValue.b, bytShiftBits.b) 
If bytShiftBits = 0 Then 
  ProcedureReturn bytValue 
  ;CONVERT: Exit Function 
ElseIf bytShiftBits = 7 Then 
  If bytValue And 1 Then 
    ProcedureReturn &H80 
  Else 
    ProcedureReturn 0 
  End If 
  ;CONVERT: Exit Function 
ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then 
  ;CONVERT: Err.Raise 6 
End If 
ProcedureReturn ((bytValue And m_bytOnBits(7 - bytShiftBits)) * m_byt2Power(bytShiftBits)) 
EndProcedure 
                                
;******************************************************************************* 
; RShiftByte (Function) 
;******************************************************************************* 
Procedure RShiftByte.b(bytValue.b, bytShiftBits.b) 
If bytShiftBits = 0 Then 
  ProcedureReturn bytValue 
  ;CONVERT: Exit Function 
ElseIf bytShiftBits = 7 Then 
  If bytValue And &H80 Then 
    ProcedureReturn 1 
  Else 
    ProcedureReturn 0 
  End If 
  ;CONVERT: Exit Function 
ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then 
  ;CONVERT: Err.Raise 6 
End If 
ProcedureReturn bytValue \ m_byt2Power(bytShiftBits) 
EndProcedure
                                        
;******************************************************************************* 
; RotateLeft (Function) 
;******************************************************************************* 
Procedure RotateLeft.l(lValue.l, iShiftBits.i) 
ProcedureReturn LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) 
EndProcedure
                                        
;'******************************************************************************* 
;' RotateLeftByte (Function) 
;******************************************************************************* 
Procedure RotateLeftByte.b(bytValue.b, bytShiftBits.b) 
ProcedureReturn LShiftByte(bytValue, bytShiftBits) Or RShiftByte(bytValue, (8 - bytShiftBits)) 
EndProcedure

;******************************************************************************* 
; Pack (Function) 
;******************************************************************************* 
Procedure Pack.l(b().b) 
lCount.l 
lTemp.l 

For lCount = 0 To 3 
  lTemp = b(lCount) 
  ;CONVERT: Pack = Pack Or LShift(lTemp, (lCount * 8)) 
Next 
EndProcedure 
                                        
;******************************************************************************* 
; PackFrom (Function) 
;******************************************************************************* 
Procedure PackFrom.l(b().b, k.b) 
lCount.l 
lTemp.l 

For lCount = 0 To 3 
  lTemp = b(lCount + k) 
  ;CONVERT: PackFrom = PackFrom Or LShift(lTemp, (lCount * 8)) 
Next 
EndProcedure 

;******************************************************************************* 
; Unpack (Sub) 
;******************************************************************************* 
Procedure Unpack(ByVal a.l, b().b) 
b(0) = a And m_lOnBits(7) 
b(1) = RShift(a, 8) And m_lOnBits(7) 
b(2) = RShift(a, 16) And m_lOnBits(7) 
b(3) = RShift(a, 24) And m_lOnBits(7) 
EndProcedure 
                                        
;******************************************************************************* 
; UnpackFrom (Sub) 
;******************************************************************************* 
Procedure UnpackFrom(a.l, b().b, k.l) 
b(0 + k) = a And m_lOnBits(7) 
b(1 + k) = RShift(a, 8) And m_lOnBits(7) 
b(2 + k) = RShift(a, 16) And m_lOnBits(7) 
b(3 + k) = RShift(a, 24) And m_lOnBits(7) 
EndProcedure

;******************************************************************************* 
; xtime (Function) 
;******************************************************************************* 
Procedure xtime.b(a.b) 
b.b

If (a And &H80) Then 
  b = &H1B 
Else 
  b = 0 
End If 
    
a = LShiftByte(a, 1) 
a = a XOr b 
    
ProcedureReturn a 
EndProcedure

Seldon · Post by **Seldon** » Mon Nov 10, 2003 8:39 am

Thank you for sharing such code !

KarLKoX · Post by **KarLKoX** » Mon Nov 10, 2003 8:01 pm

Why have you converted the LShift/RShift/LShiftByte/RShiftByte, PB have builtin shifting manipulation

Btw, thanx for sharing your sourcecode

Shannara · Post by **Shannara** » Mon Nov 10, 2003 8:13 pm

See? Those things I didnt know about

I'll look them up tonight when I get home. Also, is there an Exit Procedure command or so? To replace Exit Functions.. ? Anyways, I'll keep plugging away. I know that some of the ;CONVERT: sections are needed

Such as applying a function return to itself

But I don't know how to do that in PB yet. I will also be adding the 2nd part of the VB code that wasnt posted on this site. This will allow you to encode and decode strings. IT may do files, but I'll have to check.