QQ TEA算法VB描述
网络最高安全指南
最新资讯、海量信息导航
首页 站内搜索 标签云 管理 « HP Radia Notify Daemon多个缓冲区溢出漏洞QQ在线时间 »2005-7-2 19:01:00 | 切換到繁體中文 | 字号: 大 中 小QQ TEA算法VB描述
Tags: view plain | print | copy to clipboard | ?
1 'QQ TEA-16 Encrypt/Decrypt Class Moudle
2 '
3 '
4 'And also LumaQQ's source code
5 ' clsTea's source code
6 ' clsAES's source code
7 ' API-Guide
8 ' Thinking in Java
9 ' etc.
10 '
11 'Class Begin
12 Option Explicit
13 'Copied from clsTea's source code
14 Private m_lOnBits(30) As Long
15 Private m_l2Power(30) As Long
16 'Copied & translated from LumaQQ's source code `From LumaQQ's source code:
17 Private Plain() As Byte '指向当前的明文块
18 Private prePlain() As Byte '指向前面一个明文块
19 Private Out() As Byte '输出的密文或者明文
20 Private Crypt As Long, preCrypt As Long '当前加密的密文位置和上一次加密的密文块位置，他们相差8
21 Private Pos As Long '当前处理的加密解密块的位置
22 Private padding As Long '填充数
23 Private Key(15) As Byte '密钥
24 Private Header As Boolean '用于加密时，表示当前是否是第一个8字节块，因为加密算法
25 '是反馈的，但是最开始的8个字节没有反馈可用，所有需要标
26 '明这种情况
27 Private contextStart As Long '这个表示当前解密开始的位置，之所以要这么一个变量是为了
28 '避免当解密到最后时后面已经没有数据，这时候就会出错，这
29 '个变量就是用来判断这种情况免得出错
30
31 Public Function Encrypt(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
32 Dim Ret As Long
33 On Error GoTo ExitFunction
34 Ret = UBound(arrayKey)
35 On Error Resume Next
36 ReDim Plain(7) As Byte
37 ReDim prePlain(7) As Byte
38 Dim I As Long, l As Long
39 Pos = 1
40 padding = 0
41 Crypt = 0
42 preCrypt = 0
43 CopyMemory Key(0), arrayKey(0), 16
44 Header = True
45 Pos = 2
46 On Error Resume Next
47 Pos = (UBound(arrayIn) + 11) Mod 8
48 On Error GoTo 0
49 If Pos <> 0 Then Pos = 8 - Pos
50 On Error GoTo Out15
51 ReDim Out(UBound(arrayIn) + Pos + 10)
52 On Error GoTo 0
53 Plain(0) = (Rand And &HF8) Or Pos
54 For I = 1 To Pos
55 Plain(I) = Rand And &HFF
56 Next I
57 Pos = Pos + 1
58 padding = 1
59 Do While padding < 3
60 If Pos < 8 Then
61
62 Plain(Pos) = Rand And &HFF
63 padding = padding + 1
64 Pos = Pos + 1
65 ElseIf Pos = 8 Then
66 Encrypt8Bytes
67 End If
68 Loop
69 I = offset
70 l = 0
71 On Error Resume Next
72 l = UBound(arrayIn) + 1
73 On Error GoTo 0
74 Do While l > 0
75 If Pos < 8 Then
76 Plain(Pos) = arrayIn(I)
77 I = I + 1
78 Pos = Pos + 1
79 l = l - 1
80 ElseIf Pos = 8 Then
81 Encrypt8Bytes
82 End If
83 Loop
84 padding = 1
85 Do While padding < 9
86 If Pos < 8 Then
87 Plain(Pos) = 0
88 Pos = Pos + 1
89 padding = padding + 1
90 ElseIf Pos = 8 Then
91 Encrypt8Bytes
92 End If
93 Loop
94 Encrypt = Out
95 Exit Function
96 Out15:
97 ReDim Out(15)
98 Resume Next
99 ExitFunction:
100 End Function
101
102 Public Function Decrypt(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
103 On Error Resume Next
104 If UBound(arrayIn) < 15 Or (UBound(arrayIn) Mod 8) <> 7 Then Exit Function
105 If UBound(arrayKey) <> 15 Then Exit Function
106 Dim m() As Byte
107 Dim I As Long
108 Dim Count As Long
109 ReDim m(offset + 7) As Byte
110 CopyMemory Key(0), arrayKey(0), 16
111 Crypt = 0
112 preCrypt = 0
113 prePlain = Decipher(arrayIn, arrayKey, offset)
114 Pos = prePlain(0) And 7
115 Count = UBound(arrayIn) - Pos - 9
116 If Count < 0 Then Exit Function
117 ReDim Out(Count - 1) As Byte
118 preCrypt = 0
119 Crypt = 8
120 contextStart = 8
121 Pos = Pos + 1
122 padding = 1
123 Do While padding < 3
124 If Pos < 8 Then
125 Pos = Pos + 1
126 padding = padding + 1
127 ElseIf Pos = 8 Then
128 CopyMemory m(0), arrayIn(0), UBound(m) + 1
129 If Decrypt8Bytes(arrayIn, offset) = False Then Exit Function
130 End If
131 Loop
132 I = 0
133 Do While Count <> 0
134 If Pos < 8 Then
135 Out(I) = m(offset + preCrypt + Pos) Xor prePlain(Pos)
136 I = I + 1
137 Count = Count - 1
138 Pos = Pos + 1
139 ElseIf Pos = 8 Then
140 m = arrayIn
141 preCrypt = Crypt - 8
142 If Decrypt8Bytes(arrayIn, offset) = False Then Exit Function
143 End If
144 Loop
145 For padding = 1 To 7
146 If Pos < 8 Then
147 If (m(offset + preCrypt + Pos) Xor prePlain(Pos)) <> 0 Then Exit Function
148 Pos = Pos + 1
149 ElseIf Pos = 8 Then
150 CopyMemory m(0), arrayIn(0), UBound(m) + 1
151 preCrypt = Crypt
152 If Decrypt8Bytes(arrayIn, offset) = False Then Exit Function
153 End If
154 Next padding
155 Decrypt = Out
156 End Function
157
158 Private Function Encrypt8Bytes()
159 On Error Resume Next
160 Dim Crypted() As Byte, I As Long
161 For Pos = 0 To 7
162 If Header = True Then
163 Plain(Pos) = Plain(Pos) Xor prePlain(Pos)
164 Else
165 Plain(Pos) = Plain(Pos) Xor Out(preCrypt + Pos)
166 End If
167 Next Pos
168 Crypted = Encipher(Plain, Key)
169 For I = 0 To 7
170 Out(Crypt + I) = Crypted(I)
171 Next I
172 For Pos = 0 To 7
173 Out(Crypt + Pos) = Out(Crypt + Pos) Xor prePlain(Pos)
174 Next Pos
175 prePlain = Plain
176 preCrypt = Crypt
177 Crypt = Crypt + 8
178 Pos = 0
179 Header = False
180 End Function
181
182 Private Function Decrypt8Bytes(arrayIn() As Byte, Optional offset As Long) As Boolean
183 On Error Resume Next
184 Dim lngTemp As Long
185 For Pos = 0 To 7
186 If (contextStart + Pos) > UBound(arrayIn) Then
187 Decrypt8Bytes = True
188 Exit Function
189 End If
190 prePlain(Pos) = prePlain(Pos) Xor arrayIn(offset + Crypt + Pos)
191 Next Pos
192 prePlain = Decipher(prePlain, Key)
193 On Error GoTo ExitFunction
194 lngTemp = UBound(prePlain)
195 On Error GoTo 0
196 contextStart = contextStart + 8
197 Crypt = Crypt + 8
198 Pos = 0
199 Decrypt8Bytes = True
200 Exit Function
201 ExitFunction:
202 Decrypt8Bytes = False
203 End Function
204
205 Private Function Encipher(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
206 On Error Resume Next
207 Dim I As Long
208 Dim Y As Long, z As Long, a As Long, b As Long, c As Long, d As Long
209 Dim sum As Long, delta As Long
210 Dim tmpArray(23) As Byte
211 Dim tmpOut(7) As Byte
212 If UBound(arrayIn) < 7 Then Exit Function
213 If UBound(arrayKey) < 15 Then Exit Function
214 sum = 0
215 delta = &H9E3779B9
216 delta = delta And &HFFFFFFFF
217 tmpArray(3) = arrayIn(offset)
218 tmpArray(2) = arrayIn(offset + 1)
219 tmpArray(1) = arrayIn(offset + 2)
220 tmpArray(0) = arrayIn(offset + 3)
221 tmpArray(7) = arrayIn(offset + 4)
222 tmpArray(6) = arrayIn(offset + 5)
223 tmpArray(5) = arrayIn(offset + 6)
224 tmpArray(4) = arrayIn(offset + 7)
225 tmpArray(11) = arrayKey(0)
226 tmpArray(10) = arrayKey(1)
227 tmpArray(9) = arrayKey(2)
228 tmpArray(8) = arrayKey(3)
229 tmpArray(15) = arrayKey(4)
230 tmpArray(14) = arrayKey(5)
231 tmpArray(13) = arrayKey(6)
232 tmpArray(12) = arrayKey(7)
233 tmpArray(19) = arrayKey(8)
234 tmpArray(18) = arrayKey(9)
235 tmpArray(17) = arrayKey(10)
236 tmpArray(16) = arrayKey(11)
237 tmpArray(23) = arrayKey(12)
238 tmpArray(22) = arrayKey(13)
239 tmpArray(21) = arrayKey(14)
240 tmpArray(20) = arrayKey(15)
241 CopyMemory Y, tmpArray(0), 4
242 CopyMemory z, tmpArray(4), 4
243 CopyMemory a, tmpArray(8), 4
244 CopyMemory b, tmpArray(12), 4
245 CopyMemory c, tmpArray(16), 4
246 CopyMemory d, tmpArray(20), 4
247 For I = 1 To 16
248 sum = UnsignedAdd(sum, delta)
249 sum = sum And &HFFFFFFFF
250 Y = UnsignedAdd(Y, UnsignedAdd(LShift(z, 4), a) Xor UnsignedAdd(z, sum) Xor UnsignedAdd(RShift(z, 5), b))
251 Y = Y And &HFFFFFFFF
252 z = UnsignedAdd(z, UnsignedAdd(LShift(Y, 4), c) Xor UnsignedAdd(Y, sum) Xor UnsignedAdd(RShift(Y, 5), d))
253 z = z And &HFFFFFFFF
254 Next I
255 CopyMemory tmpArray(0), Y, 4
256 CopyMemory tmpArray(4), z, 4
257 tmpOut(0) = tmpArray(3)
258 tmpOut(1) = tmpArray(2)
259 tmpOut(2) = tmpArray(1)
260 tmpOut(3) = tmpArray(0)
261 tmpOut(4) = tmpArray(7)
262 tmpOut(5) = tmpArray(6)
263 tmpOut(6) = tmpArray(5)
264 tmpOut(7) = tmpArray(4)
265 Encipher = tmpOut
266 End Function
267
268 Private Function Decipher(arrayIn() As Byte, arrayKey() As Byte, Optional offset As Long) As Byte()
269 On Error Resume Next
270 Dim I As Long
271 Dim Y As Long, z As Long, a As Long, b As Long, c As Long, d As Long
272 Dim sum As Long, delta As Long
273 Dim tmpArray(23) As Byte
274 Dim tmpOut(7) As Byte
275 If UBound(arrayIn) < 7 Then Exit Function
276 If UBound(arrayKey) < 15 Then Exit Function
277 sum = &HE3779B90
278 sum = sum And &HFFFFFFFF
279 delta = &H9E3779B9
280 delta = delta And &HFFFFFFFF
281 tmpArray(3) = arrayIn(offset)
282 tmpArray(2) = arrayIn(offset + 1)
283 tmpArray(1) = arrayIn(offset + 2)
284 tmpArray(0) = arrayIn(offset + 3)
285 tmpArray(7) = arrayIn(offset + 4)
286 tmpArray(6) = arrayIn(offset + 5)
287 tmpArray(5) = arrayIn(offset + 6)
288 tmpArray(4) = arrayIn(offset + 7)
289 tmpArray(11) = arrayKey(0)
290 tmpArray(10) = arrayKey(1)
291 tmpArray(9) = arrayKey(2)
292 tmpArray(8) = arrayKey(3)
293 tmpArray(15) = arrayKey(4)
294 tmpArray(14) = arrayKey(5)
295 tmpArray(13) = arrayKey(6)
296 tmpArray(12) = arrayKey(7)
297 tmpArray(19) = arrayKey(8)
298 tmpArray(18) = arrayKey(9)
299 tmpArray(17) = arrayKey(10)
300 tmpArray(16) = arrayKey(11)
301 tmpArray(23) = arrayKey(12)
302 tmpArray(22) = arrayKey(13)
303 tmpArray(21) = arrayKey(14)
304 tmpArray(20) = arrayKey(15)
305 CopyMemory Y, tmpArray(0), 4
306 CopyMemory z, tmpArray(4), 4
307 CopyMemory a, tmpArray(8), 4
308 CopyMemory b, tmpArray(12), 4
309 CopyMemory c, tmpArray(16), 4
310 CopyMemory d, tmpArray(20), 4
311 For I = 1 To 16
312 z = UnsignedDel(z, (UnsignedAdd(LShift(Y, 4), c) Xor UnsignedAdd(Y, sum) Xor UnsignedAdd(RShift(Y, 5), d)))
313 z = z And &HFFFFFFFF
314 Y = UnsignedDel(Y, (UnsignedAdd(LShift(z, 4), a) Xor UnsignedAdd(z, sum) Xor UnsignedAdd(RShift(z, 5), b)))
315 Y = Y And &HFFFFFFFF
316 sum = UnsignedDel(sum, delta)
317 sum = sum And &HFFFFFFFF
318 Next I
319 CopyMemory tmpArray(0), Y, 4
320 CopyMemory tmpArray(4), z, 4
321 tmpOut(0) = tmpArray(3)
322 tmpOut(1) = tmpArray(2)
323 tmpOut(2) = tmpArray(1)
324 tmpOut(3) = tmpArray(0)
325 tmpOut(4) = tmpArray(7)
326 tmpOut(5) = tmpArray(6)
327 tmpOut(6) = tmpArray(5)
328 tmpOut(7) = tmpArray(4)
329 Decipher = tmpOut
330 End Function
331
332 Private Function LShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
333 On Error Resume Next
334 If iShiftBits = 0 Then
335 LShift = lValue
336 Exit Function
337 ElseIf iShiftBits = 31 Then
338 If lValue And 1 Then
339 LShift = &H80000000
340 Else
341 LShift = 0
342 End If
343 Exit Function
344 ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
345 Err.Raise 6
346 End If
347
348 If (lValue And m_l2Power(31 - iShiftBits)) Then
349 LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
350 Else
351 LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
352 End If
353 End Function
354
355 Private Function RShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
356 On Error Resume Next
357 If iShiftBits = 0 Then
358 RShift = lValue
359 Exit Function
360 ElseIf iShiftBits = 31 Then
361 If lValue And &H80000000 Then
362 RShift = 1
363 Else
364 RShift = 0
365 End If
366 Exit Function
367 ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
368 Err.Raise 6
369 End If
370
371 RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
372
373 If (lValue And &H80000000) Then
374 RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
375 End If
376 End Function
377
378 Private Function UnsignedAdd(ByVal Data1 As Long, Data2 As Long) As Long
379 On Error Resume Next
380 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
381 Call CopyMemory(x1(0), Data1, 4)
382 Call CopyMemory(x2(0), Data2, 4)
383 Rest = 0
384 For a = 0 To 3
385 value = CLng(x1(a)) + CLng(x2(a)) + Rest
386 xx(a) = value And 255
387 Rest = value \ 256
388 Next
389 Call CopyMemory(UnsignedAdd, xx(0), 4)
390 End Function
391
392 Private Function UnsignedDel(Data1 As Long, Data2 As Long) As Long
393 On Error Resume Next
394 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
395 Call CopyMemory(x1(0), Data1, 4)
396 Call CopyMemory(x2(0), Data2, 4)
397 Call CopyMemory(xx(0), UnsignedDel, 4)
398 For a = 0 To 3
399 value = CLng(x1(a)) - CLng(x2(a)) - Rest
400 If (value < 0) Then
401 value = value + 256
402 Rest = 1
403 Else
404 Rest = 0
405 End If
406 xx(a) = value
407 Next
408 Call CopyMemory(UnsignedDel, xx(0), 4)
409 End Function
410
411 Private Sub Class_Initialize()
412 m_lOnBits(0) = 1 ' 00000000000000000000000000000001
413 m_lOnBits(1) = 3 ' 00000000000000000000000000000011
414 m_lOnBits(2) = 7 ' 00000000000000000000000000000111
415 m_lOnBits(3) = 15 ' 00000000000000000000000000001111
416 m_lOnBits(4) = 31 ' 00000000000000000000000000011111
417 m_lOnBits(5) = 63 ' 00000000000000000000000000111111
418 m_lOnBits(6) = 127 ' 00000000000000000000000001111111
419 m_lOnBits(7) = 255 ' 00000000000000000000000011111111
420 m_lOnBits(8) = 511 ' 00000000000000000000000111111111
421 m_lOnBits(9) = 1023 ' 00000000000000000000001111111111
422 m_lOnBits(10) = 2047 ' 00000000000000000000011111111111
423 m_lOnBits(11) = 4095 ' 00000000000000000000111111111111
424 m_lOnBits(12) = 8191 ' 00000000000000000001111111111111
425 m_lOnBits(13) = 16383 ' 00000000000000000011111111111111
426 m_lOnBits(14) = 32767 ' 00000000000000000111111111111111
427 m_lOnBits(15) = 65535 ' 00000000000000001111111111111111
428 m_lOnBits(16) = 131071 ' 00000000000000011111111111111111
429 m_lOnBits(17) = 262143 ' 00000000000000111111111111111111
430 m_lOnBits(18) = 524287 ' 00000000000001111111111111111111
431 m_lOnBits(19) = 1048575 ' 00000000000011111111111111111111
432 m_lOnBits(20) = 2097151 ' 00000000000111111111111111111111
433 m_lOnBits(21) = 4194303 ' 00000000001111111111111111111111
434 m_lOnBits(22) = 8388607 ' 00000000011111111111111111111111
435 m_lOnBits(23) = 16777215 ' 00000000111111111111111111111111
436 m_lOnBits(24) = 33554431 ' 00000001111111111111111111111111
437 m_lOnBits(25) = 67108863 ' 00000011111111111111111111111111
438 m_lOnBits(26) = 134217727 ' 00000111111111111111111111111111
439 m_lOnBits(27) = 268435455 ' 00001111111111111111111111111111
440 m_lOnBits(28) = 536870911 ' 00011111111111111111111111111111
441 m_lOnBits(29) = 1073741823 ' 00111111111111111111111111111111
442 m_lOnBits(30) = 2147483647 ' 01111111111111111111111111111111
443
444 ' Could have done this with a loop calculating each value, but simply
445 ' assigning the values is quicker - POWERS OF 2
446 m_l2Power(0) = 1 ' 00000000000000000000000000000001
447 m_l2Power(1) = 2 ' 00000000000000000000000000000010
448 m_l2Power(2) = 4 ' 00000000000000000000000000000100
449 m_l2Power(3) = 8 ' 00000000000000000000000000001000
450 m_l2Power(4) = 16 ' 00000000000000000000000000010000
451 m_l2Power(5) = 32 ' 00000000000000000000000000100000
452 m_l2Power(6) = 64 ' 00000000000000000000000001000000
453 m_l2Power(7) = 128 ' 00000000000000000000000010000000
454 m_l2Power(8) = 256 ' 00000000000000000000000100000000
455 m_l2Power(9) = 512 ' 00000000000000000000001000000000
456 m_l2Power(10) = 1024 ' 00000000000000000000010000000000
457 m_l2Power(11) = 2048 ' 00000000000000000000100000000000
458 m_l2Power(12) = 4096 ' 00000000000000000001000000000000
459 m_l2Power(13) = 8192 ' 00000000000000000010000000000000
460 m_l2Power(14) = 16384 ' 00000000000000000100000000000000
461 m_l2Power(15) = 32768 ' 00000000000000001000000000000000
462 m_l2Power(16) = 65536 ' 00000000000000010000000000000000
463 m_l2Power(17) = 131072 ' 00000000000000100000000000000000
464 m_l2Power(18) = 262144 ' 00000000000001000000000000000000
465 m_l2Power(19) = 524288 ' 00000000000010000000000000000000
466 m_l2Power(20) = 1048576 ' 00000000000100000000000000000000
467 m_l2Power(21) = 2097152 ' 00000000001000000000000000000000
468 m_l2Power(22) = 4194304 ' 00000000010000000000000000000000
469 m_l2Power(23) = 8388608 ' 00000000100000000000000000000000
470 m_l2Power(24) = 16777216 ' 00000001000000000000000000000000
471 m_l2Power(25) = 33554432 ' 00000010000000000000000000000000
472 m_l2Power(26) = 67108864 ' 00000100000000000000000000000000
473 m_l2Power(27) = 134217728 ' 00001000000000000000000000000000
474 m_l2Power(28) = 268435456 ' 00010000000000000000000000000000
475 m_l2Power(29) = 536870912 ' 00100000000000000000000000000000
476 m_l2Power(30) = 1073741824 ' 01000000000000000000000000000000
477 End Sub
478
479 Private Function Rand() As Long
480 On Error Resume Next
481 Randomize Timer
482 Rand = UnsignedAdd(Int(Rnd * 2147483647), Int(Rnd * 2147483647))
483 End Function
484
485
'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
