[转] VB6.0 DES （ECB 模式）加解密

  1 Option Explicit
  2 ‘添加类模块并复制该内容, 使用时先 Dim des As New clsDES
  3 ‘======DES加密======
  4 ‘加密模式：ECB
  5 ‘填充：zeropadding
  6 ‘输出字符集：base64
  7 
  8 ‘======用法======
  9 ‘加密
 10 ‘ DES.Key = ""
 11 ‘ DES.EncryptString(date, Key)
 12 ‘解密
 13 ‘DES.DecryptString(date, Key)
 14 
 15 ‘======
 16 
 17 ‘For progress notifications
 18 Event Progress(Percent As Long)
 19 
 20 ‘Key-dependant
 21 Private m_Key(0 To 47, 1 To 16) As Byte
 22 
 23 ‘Buffered key value
 24 Private m_KeyValue As String
 25 
 26 ‘Values given in the DES standard
 27 Private m_E(0 To 63) As Byte
 28 Private m_P(0 To 31) As Byte
 29 Private m_IP(0 To 63) As Byte
 30 Private m_PC1(0 To 55) As Byte
 31 Private m_PC2(0 To 47) As Byte
 32 Private m_IPInv(0 To 63) As Byte
 33 Private m_EmptyArray(0 To 63) As Byte
 34 Private m_LeftShifts(1 To 16) As Byte
 35 Private m_sBox(0 To 7, 0 To 1, 0 To 1, 0 To 1, 0 To 1, 0 To 1, 0 To 1) As Long
 36 
 37 Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 38 
 39 Private Static Sub Byte2Bin(ByteArray() As Byte, ByteLen As Long, BinaryArray() As Byte)
 40   Dim A As Long
 41   Dim ByteValue As Byte
 42   Dim BinLength As Long
 43   
 44   ‘Clear the destination array, faster than
 45   ‘setting the data to zero in the loop below
 46   Call CopyMem(BinaryArray(0), m_EmptyArray(0), ByteLen * 8)
 47   
 48   ‘Add binary 1‘s where needed
 49   BinLength = 0
 50   For A = 0 To (ByteLen - 1)
 51     ByteValue = ByteArray(A)
 52     If (ByteValue And 128) Then BinaryArray(BinLength) = 1
 53     If (ByteValue And 64) Then BinaryArray(BinLength + 1) = 1
 54     If (ByteValue And 32) Then BinaryArray(BinLength + 2) = 1
 55     If (ByteValue And 16) Then BinaryArray(BinLength + 3) = 1
 56     If (ByteValue And 8) Then BinaryArray(BinLength + 4) = 1
 57     If (ByteValue And 4) Then BinaryArray(BinLength + 5) = 1
 58     If (ByteValue And 2) Then BinaryArray(BinLength + 6) = 1
 59     If (ByteValue And 1) Then BinaryArray(BinLength + 7) = 1
 60     BinLength = BinLength + 8
 61   Next
 62 
 63 End Sub
 64 Private Static Sub Bin2Byte(BinaryArray() As Byte, ByteLen As Long, ByteArray() As Byte)
 65 
 66   Dim A As Long
 67   Dim ByteValue As Byte
 68   Dim BinLength As Long
 69   
 70   ‘Calculate byte values
 71   BinLength = 0
 72   For A = 0 To (ByteLen - 1)
 73     ByteValue = 0
 74     If (BinaryArray(BinLength) = 1) Then ByteValue = ByteValue + 128
 75     If (BinaryArray(BinLength + 1) = 1) Then ByteValue = ByteValue + 64
 76     If (BinaryArray(BinLength + 2) = 1) Then ByteValue = ByteValue + 32
 77     If (BinaryArray(BinLength + 3) = 1) Then ByteValue = ByteValue + 16
 78     If (BinaryArray(BinLength + 4) = 1) Then ByteValue = ByteValue + 8
 79     If (BinaryArray(BinLength + 5) = 1) Then ByteValue = ByteValue + 4
 80     If (BinaryArray(BinLength + 6) = 1) Then ByteValue = ByteValue + 2
 81     If (BinaryArray(BinLength + 7) = 1) Then ByteValue = ByteValue + 1
 82     ByteArray(A) = ByteValue
 83     BinLength = BinLength + 8
 84   Next
 85   
 86 End Sub
 87 Private Static Sub EncryptBlock(BlockData() As Byte)
 88 
 89   Dim A As Long
 90   Dim i As Long
 91   Dim L(0 To 31) As Byte
 92   Dim R(0 To 31) As Byte
 93   Dim RL(0 To 63) As Byte
 94   Dim sBox(0 To 31) As Byte
 95   Dim LiRi(0 To 31) As Byte
 96   Dim ERxorK(0 To 47) As Byte
 97   Dim BinBlock(0 To 63) As Byte
 98   
 99   ‘Convert the block into a binary array
100   ‘(I do believe this is the best solution
101   ‘in VB for the DES algorithm, but it is
102   ‘still slow as xxxx)
103   Call Byte2Bin(BlockData(), 8, BinBlock())
104   
105   ‘Apply the IP permutation and split the
106   ‘block into two halves, L[] and R[]
107   For A = 0 To 31
108     L(A) = BinBlock(m_IP(A))
109     R(A) = BinBlock(m_IP(A + 32))
110   Next
111   
112   ‘Apply the 16 subkeys on the block
113   For i = 1 To 16
114     ‘E(R[i]) xor K[i]
115     ERxorK(0) = R(31) Xor m_Key(0, i)
116     ERxorK(1) = R(0) Xor m_Key(1, i)
117     ERxorK(2) = R(1) Xor m_Key(2, i)
118     ERxorK(3) = R(2) Xor m_Key(3, i)
119     ERxorK(4) = R(3) Xor m_Key(4, i)
120     ERxorK(5) = R(4) Xor m_Key(5, i)
121     ERxorK(6) = R(3) Xor m_Key(6, i)
122     ERxorK(7) = R(4) Xor m_Key(7, i)
123     ERxorK(8) = R(5) Xor m_Key(8, i)
124     ERxorK(9) = R(6) Xor m_Key(9, i)
125     ERxorK(10) = R(7) Xor m_Key(10, i)
126     ERxorK(11) = R(8) Xor m_Key(11, i)
127     ERxorK(12) = R(7) Xor m_Key(12, i)
128     ERxorK(13) = R(8) Xor m_Key(13, i)
129     ERxorK(14) = R(9) Xor m_Key(14, i)
130     ERxorK(15) = R(10) Xor m_Key(15, i)
131     ERxorK(16) = R(11) Xor m_Key(16, i)
132     ERxorK(17) = R(12) Xor m_Key(17, i)
133     ERxorK(18) = R(11) Xor m_Key(18, i)
134     ERxorK(19) = R(12) Xor m_Key(19, i)
135     ERxorK(20) = R(13) Xor m_Key(20, i)
136     ERxorK(21) = R(14) Xor m_Key(21, i)
137     ERxorK(22) = R(15) Xor m_Key(22, i)
138     ERxorK(23) = R(16) Xor m_Key(23, i)
139     ERxorK(24) = R(15) Xor m_Key(24, i)
140     ERxorK(25) = R(16) Xor m_Key(25, i)
141     ERxorK(26) = R(17) Xor m_Key(26, i)
142     ERxorK(27) = R(18) Xor m_Key(27, i)
143     ERxorK(28) = R(19) Xor m_Key(28, i)
144     ERxorK(29) = R(20) Xor m_Key(29, i)
145     ERxorK(30) = R(19) Xor m_Key(30, i)
146     ERxorK(31) = R(20) Xor m_Key(31, i)
147     ERxorK(32) = R(21) Xor m_Key(32, i)
148     ERxorK(33) = R(22) Xor m_Key(33, i)
149     ERxorK(34) = R(23) Xor m_Key(34, i)
150     ERxorK(35) = R(24) Xor m_Key(35, i)
151     ERxorK(36) = R(23) Xor m_Key(36, i)
152     ERxorK(37) = R(24) Xor m_Key(37, i)
153     ERxorK(38) = R(25) Xor m_Key(38, i)
154     ERxorK(39) = R(26) Xor m_Key(39, i)
155     ERxorK(40) = R(27) Xor m_Key(40, i)
156     ERxorK(41) = R(28) Xor m_Key(41, i)
157     ERxorK(42) = R(27) Xor m_Key(42, i)
158     ERxorK(43) = R(28) Xor m_Key(43, i)
159     ERxorK(44) = R(29) Xor m_Key(44, i)
160     ERxorK(45) = R(30) Xor m_Key(45, i)
161     ERxorK(46) = R(31) Xor m_Key(46, i)
162     ERxorK(47) = R(0) Xor m_Key(47, i)
163     
164     ‘Apply the s-boxes
165     Call CopyMem(sBox(0), m_sBox(0, ERxorK(0), ERxorK(1), ERxorK(2), ERxorK(3), ERxorK(4), ERxorK(5)), 4)
166     Call CopyMem(sBox(4), m_sBox(1, ERxorK(6), ERxorK(7), ERxorK(8), ERxorK(9), ERxorK(10), ERxorK(11)), 4)
167     Call CopyMem(sBox(8), m_sBox(2, ERxorK(12), ERxorK(13), ERxorK(14), ERxorK(15), ERxorK(16), ERxorK(17)), 4)
168     Call CopyMem(sBox(12), m_sBox(3, ERxorK(18), ERxorK(19), ERxorK(20), ERxorK(21), ERxorK(22), ERxorK(23)), 4)
169     Call CopyMem(sBox(16), m_sBox(4, ERxorK(24), ERxorK(25), ERxorK(26), ERxorK(27), ERxorK(28), ERxorK(29)), 4)
170     Call CopyMem(sBox(20), m_sBox(5, ERxorK(30), ERxorK(31), ERxorK(32), ERxorK(33), ERxorK(34), ERxorK(35)), 4)
171     Call CopyMem(sBox(24), m_sBox(6, ERxorK(36), ERxorK(37), ERxorK(38), ERxorK(39), ERxorK(40), ERxorK(41)), 4)
172     Call CopyMem(sBox(28), m_sBox(7, ERxorK(42), ERxorK(43), ERxorK(44), ERxorK(45), ERxorK(46), ERxorK(47)), 4)
173     
174     ‘L[i] xor P(R[i])
175     LiRi(0) = L(0) Xor sBox(15)
176     LiRi(1) = L(1) Xor sBox(6)
177     LiRi(2) = L(2) Xor sBox(19)
178     LiRi(3) = L(3) Xor sBox(20)
179     LiRi(4) = L(4) Xor sBox(28)
180     LiRi(5) = L(5) Xor sBox(11)
181     LiRi(6) = L(6) Xor sBox(27)
182     LiRi(7) = L(7) Xor sBox(16)
183     LiRi(8) = L(8) Xor sBox(0)
184     LiRi(9) = L(9) Xor sBox(14)
185     LiRi(10) = L(10) Xor sBox(22)
186     LiRi(11) = L(11) Xor sBox(25)
187     LiRi(12) = L(12) Xor sBox(4)
188     LiRi(13) = L(13) Xor sBox(17)
189     LiRi(14) = L(14) Xor sBox(30)
190     LiRi(15) = L(15) Xor sBox(9)
191     LiRi(16) = L(16) Xor sBox(1)
192     LiRi(17) = L(17) Xor sBox(7)
193     LiRi(18) = L(18) Xor sBox(23)
194     LiRi(19) = L(19) Xor sBox(13)
195     LiRi(20) = L(20) Xor sBox(31)
196     LiRi(21) = L(21) Xor sBox(26)
197     LiRi(22) = L(22) Xor sBox(2)
198     LiRi(23) = L(23) Xor sBox(8)
199     LiRi(24) = L(24) Xor sBox(18)
200     LiRi(25) = L(25) Xor sBox(12)
201     LiRi(26) = L(26) Xor sBox(29)
202     LiRi(27) = L(27) Xor sBox(5)
203     LiRi(28) = L(28) Xor sBox(21)
204     LiRi(29) = L(29) Xor sBox(10)
205     LiRi(30) = L(30) Xor sBox(3)
206     LiRi(31) = L(31) Xor sBox(24)
207     
208     ‘Prepare for next round
209     Call CopyMem(L(0), R(0), 32)
210     Call CopyMem(R(0), LiRi(0), 32)
211   Next
212   
213   ‘Concatenate R[]L[]
214   Call CopyMem(RL(0), R(0), 32)
215   Call CopyMem(RL(32), L(0), 32)
216 
217   ‘Apply the invIP permutation
218   For A = 0 To 63
219     BinBlock(A) = RL(m_IPInv(A))
220   Next
221   
222   ‘Convert the binaries into a byte array
223   Call Bin2Byte(BinBlock(), 8, BlockData())
224 
225 End Sub
226 Private Static Sub DecryptBlock(BlockData() As Byte)
227 
228   Dim A As Long
229   Dim i As Long
230   Dim L(0 To 31) As Byte
231   Dim R(0 To 31) As Byte
232   Dim RL(0 To 63) As Byte
233   Dim sBox(0 To 31) As Byte
234   Dim LiRi(0 To 31) As Byte
235   Dim ERxorK(0 To 47) As Byte
236   Dim BinBlock(0 To 63) As Byte
237   
238   ‘Convert the block into a binary array
239   ‘(I do believe this is the best solution
240   ‘in VB for the DES algorithm, but it is
241   ‘still slow as xxxx)
242   Call Byte2Bin(BlockData(), 8, BinBlock())
243   
244   ‘Apply the IP permutation and split the
245   ‘block into two halves, L[] and R[]
246   For A = 0 To 31
247     L(A) = BinBlock(m_IP(A))
248     R(A) = BinBlock(m_IP(A + 32))
249   Next
250   
251   ‘Apply the 16 subkeys on the block
252   For i = 16 To 1 Step -1
253     ‘E(R[i]) xor K[i]
254     ERxorK(0) = R(31) Xor m_Key(0, i)
255     ERxorK(1) = R(0) Xor m_Key(1, i)
256     ERxorK(2) = R(1) Xor m_Key(2, i)
257     ERxorK(3) = R(2) Xor m_Key(3, i)
258     ERxorK(4) = R(3) Xor m_Key(4, i)
259     ERxorK(5) = R(4) Xor m_Key(5, i)
260     ERxorK(6) = R(3) Xor m_Key(6, i)
261     ERxorK(7) = R(4) Xor m_Key(7, i)
262     ERxorK(8) = R(5) Xor m_Key(8, i)
263     ERxorK(9) = R(6) Xor m_Key(9, i)
264     ERxorK(10) = R(7) Xor m_Key(10, i)
265     ERxorK(11) = R(8) Xor m_Key(11, i)
266     ERxorK(12) = R(7) Xor m_Key(12, i)
267     ERxorK(13) = R(8) Xor m_Key(13, i)
268     ERxorK(14) = R(9) Xor m_Key(14, i)
269     ERxorK(15) = R(10) Xor m_Key(15, i)
270     ERxorK(16) = R(11) Xor m_Key(16, i)
271     ERxorK(17) = R(12) Xor m_Key(17, i)
272     ERxorK(18) = R(11) Xor m_Key(18, i)
273     ERxorK(19) = R(12) Xor m_Key(19, i)
274     ERxorK(20) = R(13) Xor m_Key(20, i)
275     ERxorK(21) = R(14) Xor m_Key(21, i)
276     ERxorK(22) = R(15) Xor m_Key(22, i)
277     ERxorK(23) = R(16) Xor m_Key(23, i)
278     ERxorK(24) = R(15) Xor m_Key(24, i)
279     ERxorK(25) = R(16) Xor m_Key(25, i)
280     ERxorK(26) = R(17) Xor m_Key(26, i)
281     ERxorK(27) = R(18) Xor m_Key(27, i)
282     ERxorK(28) = R(19) Xor m_Key(28, i)
283     ERxorK(29) = R(20) Xor m_Key(29, i)
284     ERxorK(30) = R(19) Xor m_Key(30, i)
285     ERxorK(31) = R(20) Xor m_Key(31, i)
286     ERxorK(32) = R(21) Xor m_Key(32, i)
287     ERxorK(33) = R(22) Xor m_Key(33, i)
288     ERxorK(34) = R(23) Xor m_Key(34, i)
289     ERxorK(35) = R(24) Xor m_Key(35, i)
290     ERxorK(36) = R(23) Xor m_Key(36, i)
291     ERxorK(37) = R(24) Xor m_Key(37, i)
292     ERxorK(38) = R(25) Xor m_Key(38, i)
293     ERxorK(39) = R(26) Xor m_Key(39, i)
294     ERxorK(40) = R(27) Xor m_Key(40, i)
295     ERxorK(41) = R(28) Xor m_Key(41, i)
296     ERxorK(42) = R(27) Xor m_Key(42, i)
297     ERxorK(43) = R(28) Xor m_Key(43, i)
298     ERxorK(44) = R(29) Xor m_Key(44, i)
299     ERxorK(45) = R(30) Xor m_Key(45, i)
300     ERxorK(46) = R(31) Xor m_Key(46, i)
301     ERxorK(47) = R(0) Xor m_Key(47, i)
302     
303     ‘Apply the s-boxes
304     Call CopyMem(sBox(0), m_sBox(0, ERxorK(0), ERxorK(1), ERxorK(2), ERxorK(3), ERxorK(4), ERxorK(5)), 4)
305     Call CopyMem(sBox(4), m_sBox(1, ERxorK(6), ERxorK(7), ERxorK(8), ERxorK(9), ERxorK(10), ERxorK(11)), 4)
306     Call CopyMem(sBox(8), m_sBox(2, ERxorK(12), ERxorK(13), ERxorK(14), ERxorK(15), ERxorK(16), ERxorK(17)), 4)
307     Call CopyMem(sBox(12), m_sBox(3, ERxorK(18), ERxorK(19), ERxorK(20), ERxorK(21), ERxorK(22), ERxorK(23)), 4)
308     Call CopyMem(sBox(16), m_sBox(4, ERxorK(24), ERxorK(25), ERxorK(26), ERxorK(27), ERxorK(28), ERxorK(29)), 4)
309     Call CopyMem(sBox(20), m_sBox(5, ERxorK(30), ERxorK(31), ERxorK(32), ERxorK(33), ERxorK(34), ERxorK(35)), 4)
310     Call CopyMem(sBox(24), m_sBox(6, ERxorK(36), ERxorK(37), ERxorK(38), ERxorK(39), ERxorK(40), ERxorK(41)), 4)
311     Call CopyMem(sBox(28), m_sBox(7, ERxorK(42), ERxorK(43), ERxorK(44), ERxorK(45), ERxorK(46), ERxorK(47)), 4)
312     
313     ‘L[i] xor P(R[i])
314     LiRi(0) = L(0) Xor sBox(15)
315     LiRi(1) = L(1) Xor sBox(6)
316     LiRi(2) = L(2) Xor sBox(19)
317     LiRi(3) = L(3) Xor sBox(20)
318     LiRi(4) = L(4) Xor sBox(28)
319     LiRi(5) = L(5) Xor sBox(11)
320     LiRi(6) = L(6) Xor sBox(27)
321     LiRi(7) = L(7) Xor sBox(16)
322     LiRi(8) = L(8) Xor sBox(0)
323     LiRi(9) = L(9) Xor sBox(14)
324     LiRi(10) = L(10) Xor sBox(22)
325     LiRi(11) = L(11) Xor sBox(25)
326     LiRi(12) = L(12) Xor sBox(4)
327     LiRi(13) = L(13) Xor sBox(17)
328     LiRi(14) = L(14) Xor sBox(30)
329     LiRi(15) = L(15) Xor sBox(9)
330     LiRi(16) = L(16) Xor sBox(1)
331     LiRi(17) = L(17) Xor sBox(7)
332     LiRi(18) = L(18) Xor sBox(23)
333     LiRi(19) = L(19) Xor sBox(13)
334     LiRi(20) = L(20) Xor sBox(31)
335     LiRi(21) = L(21) Xor sBox(26)
336     LiRi(22) = L(22) Xor sBox(2)
337     LiRi(23) = L(23) Xor sBox(8)
338     LiRi(24) = L(24) Xor sBox(18)
339     LiRi(25) = L(25) Xor sBox(12)
340     LiRi(26) = L(26) Xor sBox(29)
341     LiRi(27) = L(27) Xor sBox(5)
342     LiRi(28) = L(28) Xor sBox(21)
343     LiRi(29) = L(29) Xor sBox(10)
344     LiRi(30) = L(30) Xor sBox(3)
345     LiRi(31) = L(31) Xor sBox(24)
346     
347     ‘Prepare for next round
348     Call CopyMem(L(0), R(0), 32)
349     Call CopyMem(R(0), LiRi(0), 32)
350   Next
351   
352   ‘Concatenate R[]L[]
353   Call CopyMem(RL(0), R(0), 32)
354   Call CopyMem(RL(32), L(0), 32)
355 
356   ‘Apply the invIP permutation
357   For A = 0 To 63
358     BinBlock(A) = RL(m_IPInv(A))
359   Next
360   
361   ‘Convert the binaries into a byte array
362   Call Bin2Byte(BinBlock(), 8, BlockData())
363 
364 End Sub
365 
366 Public Sub EncryptByte(ByteArray() As Byte, Optional Key As String)
367 
368   Dim A As Long
369   Dim Offset As Long
370   Dim OrigLen As Long
371   Dim CipherLen As Long
372   Dim CurrPercent As Long
373   Dim NextPercent As Long
374   Dim CurrBlock(0 To 7) As Byte
375   Dim CipherBlock(0 To 7) As Byte
376   
377   ‘Set the key if provided
378   ‘设置key         这里应该和c#里面是一样的
379   If (Len(Key) > 0) Then Me.Key = Key
380 
381   ‘Get the size of the original array
382   ‘得到要加密数据的长度
383   OrigLen = UBound(ByteArray) + 1
384 
385   ‘First we add 12 bytes (4 bytes for the
386   ‘length and 8 bytes for the seed values
387   ‘for the CBC routine), and the ciphertext
388   ‘must be a multiple of 8 bytes
389   ‘不明白这里为什么要加12
390   ‘CipherLen = OrigLen + 12
391   CipherLen = IIf(OrigLen = 0, 8, OrigLen)
392   ‘加密字符串处理，不足8的倍数补齐
393   If (CipherLen Mod 8 <> 0) Then
394     CipherLen = CipherLen + 8 - (CipherLen Mod 8)
395   End If
396   ‘重新写需要加密的内容
397   ReDim Preserve ByteArray(CipherLen - 1)
398   
399   ‘参数说明
400   ‘hpvDest 要移动的目标
401   ‘hpvSource 要复制的内容
402   ‘cbCopy 要复制的字节数
403   ‘不明白这里 是不是从bytearray(12)开始复制ByteArray(0)的origlen个字节
404   ‘这里不是很明白..
405   ‘Call CopyMem(ByteArray(12), ByteArray(0), OrigLen)
406     Call CopyMem(ByteArray(0), ByteArray(0), OrigLen)
407 
408   ‘Store the length descriptor in bytes [9-12]
409   ‘这里更不明白了.ByteArray 8-11 是做什么用的？ 这个OrigLen是做什么的，和复制内存有关系吗？
410      ‘ 把origLen存储到8-11位
411 ‘‘  Call CopyMem(ByteArray(8), OrigLen, 4)
412 
413   ‘Store a block of random data in bytes [1-8],
414   ‘these work as seed values for the CBC routine
415   ‘and is used to produce different ciphertext
416   ‘even when encrypting the same data with the
417   ‘same key)
418 ‘  Call Randomize
419 ‘  ‘这里的问题同上..不明白第二个参数是怎么回事。。一个long型数据有什么用
420     ‘把随机数存储到ByteArray数组
421 ‘  Call CopyMem(ByteArray(0), CLng(2147483647 * Rnd), 4)
422 ‘  Call CopyMem(ByteArray(4), CLng(2147483647 * Rnd), 4)
423 ‘‘‘‘‘
424 
425   ‘Encrypt the data in 64-bit blocks
426   ‘加密数据
427   For Offset = 0 To (CipherLen - 1) Step 8
428     ‘Get the next block of plaintext
429     ‘依次从ByteArray中取出8位数据，复制到CurrBlock()
430     Call CopyMem(CurrBlock(0), ByteArray(Offset), 8)
431     
432     ‘XOR the plaintext with the previous
433     ‘ciphertext (CBC, Cipher-Block Chaining)
434     ‘下面这个循环不明白是做什么的。。
435     For A = 0 To 7
436       CurrBlock(A) = CurrBlock(A) Xor CipherBlock(A)
437     Next
438     
439     ‘Encrypt the block
440     ‘加密字节数据.     这是标准的加密方法吗？c#里有一个iv和一个key。为什么vb里没有设置iv的地方呢？
441     ‘这里说的iv，请看Module1里的代码，其中代码为C#加密源码，下面两个值
442     ‘  private string iv="12345678";
443     ‘  private string key="12345678";
444     Call EncryptBlock(CurrBlock())
445     
446     ‘Store the block
447     ‘将加密后的内容存储回ByteArray()
448     Call CopyMem(ByteArray(Offset), CurrBlock(0), 8)
449     
450     ‘Store the cipherblock (for CBC)
451     ‘这句不明白什么意思..应该是没用吧？
452 ‘    Call CopyMem(CipherBlock(0), CurrBlock(0), 8)
453   Next
454 End Sub
455 Public Sub DecryptByte(ByteArray() As Byte, Optional Key As String)
456 
457   Dim A As Long
458   Dim Offset As Long
459   Dim OrigLen As Long
460   Dim CipherLen As Long
461   Dim CurrPercent As Long
462   Dim NextPercent As Long
463   Dim CurrBlock(0 To 7) As Byte
464   Dim CipherBlock(0 To 7) As Byte
465   
466   ‘Set the new key if provided
467   If (Len(Key) > 0) Then Me.Key = Key
468   
469   ‘Get the size of the ciphertext
470   CipherLen = UBound(ByteArray) + 1
471   
472   ‘Decrypt the data in 64-bit blocks
473   For Offset = 0 To (CipherLen - 1) Step 8
474     ‘Get the next block of ciphertext
475     Call CopyMem(CurrBlock(0), ByteArray(Offset), 8)
476     
477     ‘Decrypt the block
478     Call DecryptBlock(CurrBlock())
479     
480     ‘XOR with the previous cipherblock
481     For A = 0 To 7
482       CurrBlock(A) = CurrBlock(A) Xor CipherBlock(A)
483     Next
484     
485     ‘Store the current ciphertext to use
486     ‘XOR with the next block plaintext
487 ‘    Call CopyMem(CipherBlock(0), ByteArray(Offset), 8)
488     
489     ‘Store the block
490     Call CopyMem(ByteArray(Offset), CurrBlock(0), 8)
491   
492     ‘Update the progress if neccessary
493 ‘‘‘    If (Offset >= NextPercent) Then
494 ‘‘‘      CurrPercent = Int((Offset / CipherLen) * 100)
495 ‘‘‘      NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
496 ‘‘‘      RaiseEvent Progress(CurrPercent)
497 ‘‘‘    End If
498   Next
499   
500   ‘Get the size of the original array
501 ‘  Call CopyMem(OrigLen, ByteArray(8), 4)
502   
503   ‘Make sure OrigLen is a reasonable value,
504   ‘if we used the wrong key the next couple
505   ‘of statements could be dangerous (GPF)
506 ‘  If (CipherLen - OrigLen > 19) Or (CipherLen - OrigLen < 12) Then
507 ‘    Call Err.Raise(vbObjectError, , "Incorrect size descriptor in DES decryption")
508 ‘  End If
509   
510   ‘Resize the bytearray to hold only the plaintext
511   ‘and not the extra information added by the
512   ‘encryption routine
513 ‘  Call CopyMem(ByteArray(0), ByteArray(12), OrigLen)
514 ‘  ReDim Preserve ByteArray(OrigLen - 1)
515 
516   ‘Make sure we return a 100% progress
517 ‘‘  If (CurrPercent <> 100) Then RaiseEvent Progress(100)
518 
519 End Sub
520 Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)
521 
522   Dim Filenr As Integer
523   Dim ByteArray() As Byte
524   
525 ‘  ‘Make sure the source file do exist
526 ‘  If (Not FileExist(SourceFile)) Then
527 ‘    Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
528 ‘    Exit Sub
529 ‘  End If
530 ‘
531   ‘Open the source file and read the content
532   ‘into a bytearray to pass onto encryption
533   Filenr = FreeFile
534   Open SourceFile For Binary As #Filenr
535   ReDim ByteArray(0 To LOF(Filenr) - 1)
536   Get #Filenr, , ByteArray()
537   Close #Filenr
538   
539   ‘Encrypt the bytearray
540   Call EncryptByte(ByteArray(), Key)
541 
542   ‘If the destination file already exist we need
543   ‘to delete it since opening it for binary use
544   ‘will preserve it if it already exist
545 ‘  If (FileExist(DestFile)) Then Kill DestFile
546   
547   ‘Store the encrypted data in the destination file
548   Filenr = FreeFile
549   Open DestFile For Binary As #Filenr
550   Put #Filenr, , ByteArray()
551   Close #Filenr
552 
553 End Sub
554 Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)
555 
556   Dim Filenr As Integer
557   Dim ByteArray() As Byte
558   
559   ‘Make sure the source file do exist
560 ‘  If (Not FileExist(SourceFile)) Then
561 ‘    Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
562 ‘    Exit Sub
563 ‘  End If
564   
565   ‘Open the source file and read the content
566   ‘into a bytearray to decrypt
567   Filenr = FreeFile
568   Open SourceFile For Binary As #Filenr
569   ReDim ByteArray(0 To LOF(Filenr) - 1)
570   Get #Filenr, , ByteArray()
571   Close #Filenr
572   
573   ‘Decrypt the bytearray
574   Call DecryptByte(ByteArray(), Key)
575 
576   ‘If the destination file already exist we need
577   ‘to delete it since opening it for binary use
578   ‘will preserve it if it already exist
579 ‘  If (FileExist(DestFile)) Then Kill DestFile
580 
581   ‘Store the decrypted data in the destination file
582   Filenr = FreeFile
583   Open DestFile For Binary As #Filenr
584   Put #Filenr, , ByteArray()
585   Close #Filenr
586 
587 End Sub
588 
589 Private Function EncodeBase64(ByRef arrData() As Byte) As String
590 
591  
592 
593     Dim objXML As MSXML2.DOMDocument
594     Dim objNode As MSXML2.IXMLDOMElement
595     
596     ‘ help from MSXML
597     Set objXML = New MSXML2.DOMDocument
598     
599     ‘ byte array to base64
600     Set objNode = objXML.createElement("b64")
601     objNode.dataType = "bin.base64"
602     objNode.nodeTypedValue = arrData
603     EncodeBase64 = objNode.Text
604 
605  
606 
607     ‘ thanks, bye
608     Set objNode = Nothing
609     Set objXML = Nothing
610 
611  
612 
613 End Function
614 
615  
616 
617 Private Function DecodeBase64(ByVal strData As String) As Byte()
618 
619  
620 
621     Dim objXML As MSXML2.DOMDocument
622     Dim objNode As MSXML2.IXMLDOMElement
623     
624     ‘ help from MSXML
625     Set objXML = New MSXML2.DOMDocument
626     Set objNode = objXML.createElement("b64")
627     objNode.dataType = "bin.base64"
628     objNode.Text = strData
629     DecodeBase64 = objNode.nodeTypedValue
630     
631     ‘ thanks, bye
632     Set objNode = Nothing
633     Set objXML = Nothing
634 
635  
636 
637 End Function
638 Public Function EncryptString(Text As String, Optional Key As String) As String
639 
640   Dim ByteArray() As Byte
641   ‘Convert the text into a byte array
642   ByteArray() = StrConv(Text, vbFromUnicode)
643   ‘ByteArray() = DecodeBase64(Text)
644 ‘‘‘‘‘    byteA() = StrConv(Text, vbFromUnicode)
645 ‘‘‘‘‘  ‘ByteArray() = DecodeBase64(Text)
646 ‘‘‘‘‘  Dim ByteArray() As Byte
647 ‘‘‘‘‘  ReDim ByteArray((UBound(byteA) + 1) * 2 - 1)
648 ‘‘‘‘‘  Dim i As Integer
649 ‘‘‘‘‘  For i = 0 To UBound(byteA)
650 ‘‘‘‘‘        ByteArray(i * 2) = byteA(i)
651 ‘‘‘‘‘        ByteArray(i * 2 + 1) = 0
652 ‘‘‘‘‘  Next i
653   ‘Encrypt the byte array
654   Call EncryptByte(ByteArray(), Key)
655   
656   ‘Convert the byte array back to a string
657 ‘  EncryptString = StrConv(ByteArray(), vbUnicode)
658     EncryptString = EncodeBase64(ByteArray())
659 End Function
660 
661 Public Function DecryptString(Text As String, Optional Key As String) As String
662 
663   Dim ByteArray() As Byte
664   
665   ‘Convert the text into a byte array
666 ‘  ByteArray() = StrConv(Text, vbFromUnicode)
667   ByteArray() = DecodeBase64(Text)
668   
669   ‘Encrypt the byte array
670   Call DecryptByte(ByteArray(), Key)
671   
672   ‘Convert the byte array back to a string EncodeBase64(ByteArray()) ‘
673   DecryptString = StrConv(ByteArray(), vbUnicode)
674 
675 End Function
676 
677 
678 Public Property Let Key(New_Value As String)
679 
680   Dim A As Long
681   Dim i As Long
682   Dim C(0 To 27) As Byte
683   Dim D(0 To 27) As Byte
684   Dim K(0 To 55) As Byte
685   Dim CD(0 To 55) As Byte
686   Dim Temp(0 To 1) As Byte
687   Dim KeyBin(0 To 63) As Byte
688   Dim KeySchedule(0 To 63) As Byte
689   
690   ‘Do nothing if the key is buffered
691   If (m_KeyValue = New_Value) Then Exit Property
692   
693   ‘Store a string value of the buffered key
694   m_KeyValue = New_Value
695   
696   ‘Convert the key to a binary array
697   Call Byte2Bin(StrConv(New_Value, vbFromUnicode), IIf(Len(New_Value) > 8, 8, Len(New_Value)), KeyBin())
698 
699   ‘Apply the PC-2 permutation
700   For A = 0 To 55
701     KeySchedule(A) = KeyBin(m_PC1(A))
702   Next
703   
704   ‘Split keyschedule into two halves, C[] and D[]
705   Call CopyMem(C(0), KeySchedule(0), 28)
706   Call CopyMem(D(0), KeySchedule(28), 28)
707   
708   ‘Calculate the key schedule (16 subkeys)
709   For i = 1 To 16
710     ‘Perform one or two cyclic left shifts on
711     ‘both C[i-1] and D[i-1] to get C[i] and D[i]
712     Call CopyMem(Temp(0), C(0), m_LeftShifts(i))
713     Call CopyMem(C(0), C(m_LeftShifts(i)), 28 - m_LeftShifts(i))
714     Call CopyMem(C(28 - m_LeftShifts(i)), Temp(0), m_LeftShifts(i))
715     Call CopyMem(Temp(0), D(0), m_LeftShifts(i))
716     Call CopyMem(D(0), D(m_LeftShifts(i)), 28 - m_LeftShifts(i))
717     Call CopyMem(D(28 - m_LeftShifts(i)), Temp(0), m_LeftShifts(i))
718     
719     ‘Concatenate C[] and D[]
720     Call CopyMem(CD(0), C(0), 28)
721     Call CopyMem(CD(28), D(0), 28)
722     
723     ‘Apply the PC-2 permutation and store
724     ‘the calculated subkey
725     For A = 0 To 47
726       m_Key(A, i) = CD(m_PC2(A))
727     Next
728   Next
729 
730 End Property
731 Private Sub Class_Initialize()
732 
733   Dim i As Long
734   Dim vE As Variant
735   Dim vP As Variant
736   Dim vIP As Variant
737   Dim vPC1 As Variant
738   Dim vPC2 As Variant
739   Dim vIPInv As Variant
740   Dim vSbox(0 To 7) As Variant
741   
742   ‘Initialize the permutation IP
743   vIP = Array(58, 50, 42, 34, 26, 18, 10, 2, _
744               60, 52, 44, 36, 28, 20, 12, 4, _
745               62, 54, 46, 38, 30, 22, 14, 6, _
746               64, 56, 48, 40, 32, 24, 16, 8, _
747               57, 49, 41, 33, 25, 17, 9, 1, _
748               59, 51, 43, 35, 27, 19, 11, 3, _
749               61, 53, 45, 37, 29, 21, 13, 5, _
750               63, 55, 47, 39, 31, 23, 15, 7)
751   
752   ‘Create the permutation IP
753   For i = LBound(vIP) To UBound(vIP)
754     m_IP(i) = (vIP(i) - 1)
755   Next
756   
757   ‘Initialize the expansion function E
758   vE = Array(32, 1, 2, 3, 4, 5, _
759              4, 5, 6, 7, 8, 9, _
760              8, 9, 10, 11, 12, 13, _
761              12, 13, 14, 15, 16, 17, _
762              16, 17, 18, 19, 20, 21, _
763              20, 21, 22, 23, 24, 25, _
764              24, 25, 26, 27, 28, 29, _
765              28, 29, 30, 31, 32, 1)
766   
767   ‘Create the expansion array
768   For i = LBound(vE) To UBound(vE)
769     m_E(i) = (vE(i) - 1)
770   Next
771   
772   ‘Initialize the PC1 function
773   vPC1 = Array(57, 49, 41, 33, 25, 17, 9, _
774                1, 58, 50, 42, 34, 26, 18, _
775                10, 2, 59, 51, 43, 35, 27, _
776                19, 11, 3, 60, 52, 44, 36, _
777                63, 55, 47, 39, 31, 23, 15, _
778                7, 62, 54, 46, 38, 30, 22, _
779                14, 6, 61, 53, 45, 37, 29, _
780                21, 13, 5, 28, 20, 12, 4)
781 
782   ‘Create the PC1 function
783   For i = LBound(vPC1) To UBound(vPC1)
784     m_PC1(i) = (vPC1(i) - 1)
785   Next
786   
787   ‘Initialize the PC2 function
788   vPC2 = Array(14, 17, 11, 24, 1, 5, _
789                3, 28, 15, 6, 21, 10, _
790                23, 19, 12, 4, 26, 8, _
791                16, 7, 27, 20, 13, 2, _
792                41, 52, 31, 37, 47, 55, _
793                30, 40, 51, 45, 33, 48, _
794                44, 49, 39, 56, 34, 53, _
795                46, 42, 50, 36, 29, 32)
796   
797   ‘Create the PC2 function
798   For i = LBound(vPC2) To UBound(vPC2)
799     m_PC2(i) = (vPC2(i) - 1)
800   Next
801   
802   ‘Initialize the inverted IP
803   vIPInv = Array(40, 8, 48, 16, 56, 24, 64, 32, _
804                  39, 7, 47, 15, 55, 23, 63, 31, _
805                  38, 6, 46, 14, 54, 22, 62, 30, _
806                  37, 5, 45, 13, 53, 21, 61, 29, _
807                  36, 4, 44, 12, 52, 20, 60, 28, _
808                  35, 3, 43, 11, 51, 19, 59, 27, _
809                  34, 2, 42, 10, 50, 18, 58, 26, _
810                  33, 1, 41, 9, 49, 17, 57, 25)
811   
812   ‘Create the inverted IP
813   For i = LBound(vIPInv) To UBound(vIPInv)
814     m_IPInv(i) = (vIPInv(i) - 1)
815   Next
816     
817   ‘Initialize permutation P
818   vP = Array(16, 7, 20, 21, _
819              29, 12, 28, 17, _
820              1, 15, 23, 26, _
821              5, 18, 31, 10, _
822              2, 8, 24, 14, _
823              32, 27, 3, 9, _
824              19, 13, 30, 6, _
825              22, 11, 4, 25)
826 
827   ‘Create P
828   For i = LBound(vP) To UBound(vP)
829     m_P(i) = (vP(i) - 1)
830   Next
831   
832   ‘Initialize the leftshifts array
833   For i = 1 To 16
834     Select Case i
835     Case 1, 2, 9, 16
836       m_LeftShifts(i) = 1
837     Case Else
838       m_LeftShifts(i) = 2
839     End Select
840   Next
841   
842   ‘Initialize the eight s-boxes
843   vSbox(0) = Array(14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7, _
844                    0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8, _
845                    4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0, _
846                    15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)
847 
848   vSbox(1) = Array(15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10, _
849                    3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5, _
850                    0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15, _
851                    13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)
852 
853   vSbox(2) = Array(10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8, _
854                    13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1, _
855                    13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7, _
856                    1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)
857 
858   vSbox(3) = Array(7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15, _
859                    13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9, _
860                    10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4, _
861                    3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)
862 
863   vSbox(4) = Array(2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9, _
864                    14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6, _
865                    4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14, _
866                    11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)
867   
868   vSbox(5) = Array(12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11, _
869                    10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8, _
870                    9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6, _
871                    4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)
872   
873   vSbox(6) = Array(4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1, _
874                    13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6, _
875                    1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2, _
876                    6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)
877   
878   vSbox(7) = Array(13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7, _
879                    1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2, _
880                    7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8, _
881                    2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)
882   
883   Dim lBox As Long
884   Dim lRow As Long
885   Dim lColumn As Long
886   Dim TheByte(0) As Byte
887   Dim TheBin(0 To 7) As Byte
888   Dim A As Byte, B As Byte, C As Byte, D As Byte, e As Byte, F As Byte
889   
890   ‘Create an optimized version of the s-boxes
891   ‘this is not in the standard but much faster
892   ‘than calculating the Row/Column index later
893   For lBox = 0 To 7
894     For A = 0 To 1
895       For B = 0 To 1
896         For C = 0 To 1
897           For D = 0 To 1
898             For e = 0 To 1
899               For F = 0 To 1
900                 lRow = A * 2 + F
901                 lColumn = B * 8 + C * 4 + D * 2 + e
902                 TheByte(0) = vSbox(lBox)(lRow * 16 + lColumn)
903                 Call Byte2Bin(TheByte(), 1, TheBin())
904                 Call CopyMem(m_sBox(lBox, A, B, C, D, e, F), TheBin(4), 4)
905               Next
906             Next
907           Next
908         Next
909       Next
910     Next
911   Next
912 
913 End Sub