’QQ TEA-16 Encrypt/Decrypt Class Moudle
’
’
’And also LumaQQ’s source code
’ clsTea’s source code
’ clsAES’s source code
’ API-Guide
’ Thinking in Java
’ etc.
’
’Class Begin
Option Explicit
’Copied from clsTea’s source code
Private m_lOnBits(30) As Long
Private m_l2Power(30) As Long
’Copied & translated from LumaQQ’s source code `From LumaQQ’s source code:
Private Plain() As Byte ’指向当前的明文块
Private prePlain() As Byte ’指向前面一个明文块
Private Out() As Byte ’输出的密文或者明文
Private Crypt As Long, preCrypt As Long ’当前加密的密文位置和上一次加密的密文块位置，他们相差8
Private Pos As Long ’当前处理的加密解密块的位置
Private padding As Long ’填充数
Private Key(15) As Byte ’密钥
Private Header As Boolean ’用于加密时，表示当前是否是第一个8字节块，因为加密算法
’是反馈的，但是最开始的8个字节没有反馈可用，所有需要标
’明这种情况
Private contextStart As Long ’这个表示当前解密开始的位置，之所以要这么一个变量是为了
’避免当解密到最后时后面已经没有数据，这时候就会出错，这
’个变量就是用来判断这种情况免得出错
Public Function Encrypt(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
Dim Ret As Long
On Error GoTo ExitFunction
Ret = UBound(arrayKey)
On Error Resume Next
ReDim Plain(7) As Byte
ReDim prePlain(7) As Byte
Dim I As Long, l As Long
Pos = 1
padding = 0
Crypt = 0
preCrypt = 0
CopyMemory Key(0), arrayKey(0), 16
Header = True
Pos = 2
On Error Resume Next
Pos = (UBound(arrayIn) + 11) Mod 8
On Error GoTo 0
If Pos <> 0 Then Pos = 8 - Pos
On Error GoTo Out15
ReDim Out(UBound(arrayIn) + Pos + 10)
On Error GoTo 0
Plain(0) = (Rand And &HF8) Or Pos
For I = 1 To Pos
Plain(I) = Rand And &HFF
Next I
Pos = Pos + 1
padding = 1
Do While padding < 3
If Pos < 8 Then
Plain(Pos) = Rand And &HFF
padding = padding + 1
Pos = Pos + 1
ElseIf Pos = 8 Then
Encrypt8Bytes
End If
Loop
I = offset
l = 0
On Error Resume Next
l = UBound(arrayIn) + 1
On Error GoTo 0
Do While l > 0
If Pos < 8 Then
Plain(Pos) = arrayIn(I)
I = I + 1
Pos = Pos + 1
l = l - 1
ElseIf Pos = 8 Then
Encrypt8Bytes
End If
Loop
padding = 1
Do While padding < 9
If Pos < 8 Then
Plain(Pos) = 0
Pos = Pos + 1
padding = padding + 1
ElseIf Pos = 8 Then
Encrypt8Bytes
End If
Loop
Encrypt = Out
Exit Function
Out15:
ReDim Out(15)
Resume Next
ExitFunction:
End Function
Public Function Decrypt(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
On Error Resume Next
If UBound(arrayIn) < 15 Or (UBound(arrayIn) Mod 8) <> 7 Then Exit Function
If UBound(arrayKey) <> 15 Then Exit Function
Dim m() As Byte
Dim I As Long
Dim Count As Long
ReDim m(offset + 7) As Byte
CopyMemory Key(0), arrayKey(0), 16
Crypt = 0
preCrypt = 0
prePlain = Decipher(arrayIn, arrayKey, offset)
Pos = prePlain(0) And 7
Count = UBound(arrayIn) - Pos - 9
If Count < 0 Then Exit Function
ReDim Out(Count - 1) As Byte
preCrypt = 0
Crypt = 8
contextStart = 8
Pos = Pos + 1
padding = 1
Do While padding < 3
If Pos < 8 Then
Pos = Pos + 1
padding = padding + 1
ElseIf Pos = 8 Then
CopyMemory m(0), arrayIn(0), UBound(m) + 1
If Decrypt8Bytes(arrayIn, offset) = False Then Exit Function
End If
Loop
I = 0
Do While Count <> 0
If Pos < 8 Then
Out(I) = m(offset + preCrypt + Pos) Xor prePlain(Pos)
I = I + 1
Count = Count - 1
Pos = Pos + 1
ElseIf Pos = 8 Then
m = arrayIn
preCrypt = Crypt - 8
If Decrypt8Bytes(arrayIn, offset) = False Then Exit Function
End If
Loop
For padding = 1 To 7
If Pos < 8 Then
If (m(offset + preCrypt + Pos) Xor prePlain(Pos)) <> 0 Then Exit Function
Pos = Pos + 1
ElseIf Pos = 8 Then
CopyMemory m(0), arrayIn(0), UBound(m) + 1
preCrypt = Crypt
If Decrypt8Bytes(arrayIn, offset) = False Then Exit Function
End If
Next padding
Decrypt = Out
End Function
Private Function Encrypt8Bytes()
On Error Resume Next
Dim Crypted() As Byte, I As Long
For Pos = 0 To 7
If Header = True Then
Plain(Pos) = Plain(Pos) Xor prePlain(Pos)
Else
Plain(Pos) = Plain(Pos) Xor Out(preCrypt + Pos)
End If
Next Pos
Crypted = Encipher(Plain, Key)
For I = 0 To 7
Out(Crypt + I) = Crypted(I)
Next I
For Pos = 0 To 7
Out(Crypt + Pos) = Out(Crypt + Pos) Xor prePlain(Pos)
Next Pos
prePlain = Plain
preCrypt = Crypt
Crypt = Crypt + 8
Pos = 0
Header = False
End Function
Private Function Decrypt8Bytes(arrayIn() As Byte, Optional offset As Long) As Boolean
On Error Resume Next
Dim lngTemp As Long
For Pos = 0 To 7
If (contextStart + Pos) > UBound(arrayIn) Then
Decrypt8Bytes = True
Exit Function
End If
prePlain(Pos) = prePlain(Pos) Xor arrayIn(offset + Crypt + Pos)
Next Pos
prePlain = Decipher(prePlain, Key)
On Error GoTo ExitFunction
lngTemp = UBound(prePlain)
On Error GoTo 0
contextStart = contextStart + 8
Crypt = Crypt + 8
Pos = 0
Decrypt8Bytes = True
Exit Function
ExitFunction:
Decrypt8Bytes = False
End Function
Private Function Encipher(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
On Error Resume Next
Dim I As Long
Dim Y As Long, z As Long, a As Long, b As Long, c As Long, d As Long
Dim sum As Long, delta As Long
Dim tmpArray(23) As Byte
Dim tmpOut(7) As Byte
If UBound(arrayIn) < 7 Then Exit Function
If UBound(arrayKey) < 15 Then Exit Function
sum = 0
delta = &H9E3779B9
delta = delta And &HFFFFFFFF
tmpArray(3) = arrayIn(offset)
tmpArray(2) = arrayIn(offset + 1)
tmpArray(1) = arrayIn(offset + 2)
tmpArray(0) = arrayIn(offset + 3)
tmpArray(7) = arrayIn(offset + 4)
tmpArray(6) = arrayIn(offset + 5)
tmpArray(5) = arrayIn(offset + 6)
tmpArray(4) = arrayIn(offset + 7)
tmpArray(11) = arrayKey(0)
tmpArray(10) = arrayKey(1)
tmpArray(9) = arrayKey(2)
tmpArray(8) = arrayKey(3)
tmpArray(15) = arrayKey(4)
tmpArray(14) = arrayKey(5)
tmpArray(13) = arrayKey(6)
tmpArray(12) = arrayKey(7)
tmpArray(19) = arrayKey(8)
tmpArray(18) = arrayKey(9)
tmpArray(17) = arrayKey(10)
tmpArray(16) = arrayKey(11)
tmpArray(23) = arrayKey(12)
tmpArray(22) = arrayKey(13)
tmpArray(21) = arrayKey(14)
tmpArray(20) = arrayKey(15)
CopyMemory Y, tmpArray(0), 4
CopyMemory z, tmpArray(4), 4
CopyMemory a, tmpArray(8), 4
CopyMemory b, tmpArray(12), 4
CopyMemory c, tmpArray(16), 4
CopyMemory d, tmpArray(20), 4
For I = 1 To 16
sum = UnsignedAdd(sum, delta)
sum = sum And &HFFFFFFFF
Y = UnsignedAdd(Y, UnsignedAdd(LShift(z, 4), a) Xor UnsignedAdd(z, sum) Xor UnsignedAdd(RShift(z, 5), b))
Y = Y And &HFFFFFFFF
z = UnsignedAdd(z, UnsignedAdd(LShift(Y, 4), c) Xor UnsignedAdd(Y, sum) Xor UnsignedAdd(RShift(Y, 5), d))
z = z And &HFFFFFFFF
Next I
CopyMemory tmpArray(0), Y, 4
CopyMemory tmpArray(4), z, 4
tmpOut(0) = tmpArray(3)
tmpOut(1) = tmpArray(2)
tmpOut(2) = tmpArray(1)
tmpOut(3) = tmpArray(0)
tmpOut(4) = tmpArray(7)
tmpOut(5) = tmpArray(6)
tmpOut(6) = tmpArray(5)
tmpOut(7) = tmpArray(4)
Encipher = tmpOut
End Function
Private Function Decipher(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
On Error Resume Next
Dim I As Long
Dim Y As Long, z As Long, a As Long, b As Long, c As Long, d As Long
Dim sum As Long, delta As Long
Dim tmpArray(23) As Byte
Dim tmpOut(7) As Byte
If UBound(arrayIn) < 7 Then Exit Function
If UBound(arrayKey) < 15 Then Exit Function
sum = &HE3779B90
sum = sum And &HFFFFFFFF
delta = &H9E3779B9
delta = delta And &HFFFFFFFF
tmpArray(3) = arrayIn(offset)
tmpArray(2) = arrayIn(offset + 1)
tmpArray(1) = arrayIn(offset + 2)
tmpArray(0) = arrayIn(offset + 3)
tmpArray(7) = arrayIn(offset + 4)
tmpArray(6) = arrayIn(offset + 5)
tmpArray(5) = arrayIn(offset + 6)
tmpArray(4) = arrayIn(offset + 7)
tmpArray(11) = arrayKey(0)
tmpArray(10) = arrayKey(1)
tmpArray(9) = arrayKey(2)
tmpArray(8) = arrayKey(3)
tmpArray(15) = arrayKey(4)
tmpArray(14) = arrayKey(5)
tmpArray(13) = arrayKey(6)
tmpArray(12) = arrayKey(7)
tmpArray(19) = arrayKey(8)
tmpArray(18) = arrayKey(9)
tmpArray(17) = arrayKey(10)
tmpArray(16) = arrayKey(11)
tmpArray(23) = arrayKey(12)
tmpArray(22) = arrayKey(13)
tmpArray(21) = arrayKey(14)
tmpArray(20) = arrayKey(15)
CopyMemory Y, tmpArray(0), 4
CopyMemory z, tmpArray(4), 4
CopyMemory a, tmpArray(8), 4
CopyMemory b, tmpArray(12), 4
CopyMemory c, tmpArray(16), 4
CopyMemory d, tmpArray(20), 4
For I = 1 To 16
z = UnsignedDel(z, (UnsignedAdd(LShift(Y, 4), c) Xor UnsignedAdd(Y, sum) Xor UnsignedAdd(RShift(Y, 5), d)))
z = z And &HFFFFFFFF
Y = UnsignedDel(Y, (UnsignedAdd(LShift(z, 4), a) Xor UnsignedAdd(z, sum) Xor UnsignedAdd(RShift(z, 5), b)))
Y = Y And &HFFFFFFFF
sum = UnsignedDel(sum, delta)
sum = sum And &HFFFFFFFF
Next I
CopyMemory tmpArray(0), Y, 4
CopyMemory tmpArray(4), z, 4
tmpOut(0) = tmpArray(3)
tmpOut(1) = tmpArray(2)
tmpOut(2) = tmpArray(1)
tmpOut(3) = tmpArray(0)
tmpOut(4) = tmpArray(7)
tmpOut(5) = tmpArray(6)
tmpOut(6) = tmpArray(5)
tmpOut(7) = tmpArray(4)
Decipher = tmpOut
End Function
Private Function LShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
On Error Resume Next
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
Private Function RShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
On Error Resume Next
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
Private Function UnsignedAdd(ByVal Data1 As Long, Data2 As Long) As Long
On Error Resume Next
Dim x1(0 To 3) As Byte, x2(0 To 3) As Byte, xx(0 To 3) As Byte, Rest As Long, value As Long, a As Long
Call CopyMemory(x1(0), Data1, 4)
Call CopyMemory(x2(0), Data2, 4)
Rest = 0
For a = 0 To 3
value = CLng(x1(a)) + CLng(x2(a)) + Rest
xx(a) = value And 255
Rest = value \ 256
Next
Call CopyMemory(UnsignedAdd, xx(0), 4)
End Function
Private Function UnsignedDel(Data1 As Long, Data2 As Long) As Long
On Error Resume Next
Dim x1(0 To 3) As Byte, x2(0 To 3) As Byte, xx(0 To 3) As Byte, Rest As Long, value As Long, a As Long
Call CopyMemory(x1(0), Data1, 4)
Call CopyMemory(x2(0), Data2, 4)
Call CopyMemory(xx(0), UnsignedDel, 4)
For a = 0 To 3
value = CLng(x1(a)) - CLng(x2(a)) - Rest
If (value < 0) Then
value = value + 256
Rest = 1
Else
Rest = 0
End If
xx(a) = value
Next
Call CopyMemory(UnsignedDel, xx(0), 4)
End Function
Private Sub Class_Initialize()
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
Private Function Rand() As Long
On Error Resume Next
Randomize Timer
Rand = UnsignedAdd(Int(Rnd * 2147483647), Int(Rnd * 2147483647))
End Function
