📄 clsdes.cls
字号:
'Store the block
Call CopyMem(ByteArray(Offset), CurrBlock(0), 8)
'Store the cipherblock (for CBC)
Call CopyMem(CipherBlock(0), CurrBlock(0), 8)
'Update the progress if neccessary
If (Offset >= NextPercent) Then
CurrPercent = Int((Offset / CipherLen) * 100)
NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
RaiseEvent Progress(CurrPercent)
End If
Next
'Make sure we return a 100% progress
If (CurrPercent <> 100) Then RaiseEvent Progress(100)
End Sub
Public Sub DecryptByte(ByteArray() As Byte, Optional Key As String)
Dim a As Long
Dim Offset As Long
Dim OrigLen As Long
Dim CipherLen As Long
Dim CurrPercent As Long
Dim NextPercent As Long
Dim CurrBlock(0 To 7) As Byte
Dim CipherBlock(0 To 7) As Byte
'Set the new key if provided
If (Len(Key) > 0) Then Me.Key = Key
'Get the size of the ciphertext
CipherLen = UBound(ByteArray) + 1
'Decrypt the data in 64-bit blocks
For Offset = 0 To (CipherLen - 1) Step 8
'Get the next block of ciphertext
Call CopyMem(CurrBlock(0), ByteArray(Offset), 8)
'Decrypt the block
Call DecryptBlock(CurrBlock())
'XOR with the previous cipherblock
For a = 0 To 7
CurrBlock(a) = CurrBlock(a) Xor CipherBlock(a)
Next
'Store the current ciphertext to use
'XOR with the next block plaintext
Call CopyMem(CipherBlock(0), ByteArray(Offset), 8)
'Store the block
Call CopyMem(ByteArray(Offset), CurrBlock(0), 8)
'Update the progress if neccessary
If (Offset >= NextPercent) Then
CurrPercent = Int((Offset / CipherLen) * 100)
NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
RaiseEvent Progress(CurrPercent)
End If
Next
'Get the size of the original array
Call CopyMem(OrigLen, ByteArray(8), 4)
'Make sure OrigLen is a reasonable value,
'if we used the wrong key the next couple
'of statements could be dangerous (GPF)
If (CipherLen - OrigLen > 19) Or (CipherLen - OrigLen < 12) Then
Call Err.Raise(vbObjectError, , "Incorrect size descriptor in DES decryption")
End If
'Resize the bytearray to hold only the plaintext
'and not the extra information added by the
'encryption routine
Call CopyMem(ByteArray(0), ByteArray(12), OrigLen)
ReDim Preserve ByteArray(OrigLen - 1)
'Make sure we return a 100% progress
If (CurrPercent <> 100) Then RaiseEvent Progress(100)
End Sub
Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the source file do exist
If (Not FileExist(SourceFile)) Then
Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
Exit Sub
End If
'Open the source file and read the content
'into a bytearray to pass onto encryption
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Encrypt the bytearray
Call EncryptByte(ByteArray(), Key)
'If the destination file already exist we need
'to delete it since opening it for binary use
'will preserve it if it already exist
If (FileExist(DestFile)) Then Kill DestFile
'Store the encrypted data in the destination file
Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the source file do exist
If (Not FileExist(SourceFile)) Then
Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
Exit Sub
End If
'Open the source file and read the content
'into a bytearray to decrypt
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Decrypt the bytearray
Call DecryptByte(ByteArray(), Key)
'If the destination file already exist we need
'to delete it since opening it for binary use
'will preserve it if it already exist
If (FileExist(DestFile)) Then Kill DestFile
'Store the decrypted data in the destination file
Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Public Function EncryptString(Text As String, Optional Key As String) As String
Dim ByteArray() As Byte
'Convert the text into a byte array
ByteArray() = StrConv(Text, vbFromUnicode)
'Encrypt the byte array
Call EncryptByte(ByteArray(), Key)
'Convert the byte array back to a string
EncryptString = StrConv(ByteArray(), vbUnicode)
End Function
Public Function DecryptString(Text As String, Optional Key As String) As String
Dim ByteArray() As Byte
'Convert the text into a byte array
ByteArray() = StrConv(Text, vbFromUnicode)
'Encrypt the byte array
Call DecryptByte(ByteArray(), Key)
'Convert the byte array back to a string
DecryptString = StrConv(ByteArray(), vbUnicode)
End Function
Public Property Let Key(New_Value As String)
Dim a As Long
Dim i As Long
Dim C(0 To 27) As Byte
Dim D(0 To 27) As Byte
Dim K(0 To 55) As Byte
Dim CD(0 To 55) As Byte
Dim Temp(0 To 1) As Byte
Dim KeyBin(0 To 63) As Byte
Dim KeySchedule(0 To 63) As Byte
'Do nothing if the key is buffered
If (m_KeyValue = New_Value) Then Exit Property
'Store a string value of the buffered key
m_KeyValue = New_Value
'Convert the key to a binary array
Call Byte2Bin(StrConv(New_Value, vbFromUnicode), IIf(Len(New_Value) > 8, 8, Len(New_Value)), KeyBin())
'Apply the PC-2 permutation
For a = 0 To 55
KeySchedule(a) = KeyBin(m_PC1(a))
Next
'Split keyschedule into two halves, C[] and D[]
Call CopyMem(C(0), KeySchedule(0), 28)
Call CopyMem(D(0), KeySchedule(28), 28)
'Calculate the key schedule (16 subkeys)
For i = 1 To 16
'Perform one or two cyclic left shifts on
'both C[i-1] and D[i-1] to get C[i] and D[i]
Call CopyMem(Temp(0), C(0), m_LeftShifts(i))
Call CopyMem(C(0), C(m_LeftShifts(i)), 28 - m_LeftShifts(i))
Call CopyMem(C(28 - m_LeftShifts(i)), Temp(0), m_LeftShifts(i))
Call CopyMem(Temp(0), D(0), m_LeftShifts(i))
Call CopyMem(D(0), D(m_LeftShifts(i)), 28 - m_LeftShifts(i))
Call CopyMem(D(28 - m_LeftShifts(i)), Temp(0), m_LeftShifts(i))
'Concatenate C[] and D[]
Call CopyMem(CD(0), C(0), 28)
Call CopyMem(CD(28), D(0), 28)
'Apply the PC-2 permutation and store
'the calculated subkey
For a = 0 To 47
m_Key(a, i) = CD(m_PC2(a))
Next
Next
End Property
Private Sub Class_Initialize()
Dim i As Long
Dim vE As Variant
Dim vP As Variant
Dim vIP As Variant
Dim vPC1 As Variant
Dim vPC2 As Variant
Dim vIPInv As Variant
Dim vSbox(0 To 7) As Variant
'Initialize the permutation IP
vIP = Array(58, 50, 42, 34, 26, 18, 10, 2, _
60, 52, 44, 36, 28, 20, 12, 4, _
62, 54, 46, 38, 30, 22, 14, 6, _
64, 56, 48, 40, 32, 24, 16, 8, _
57, 49, 41, 33, 25, 17, 9, 1, _
59, 51, 43, 35, 27, 19, 11, 3, _
61, 53, 45, 37, 29, 21, 13, 5, _
63, 55, 47, 39, 31, 23, 15, 7)
'Create the permutation IP
For i = LBound(vIP) To UBound(vIP)
m_IP(i) = (vIP(i) - 1)
Next
'Initialize the expansion function E
vE = Array(32, 1, 2, 3, 4, 5, _
4, 5, 6, 7, 8, 9, _
8, 9, 10, 11, 12, 13, _
12, 13, 14, 15, 16, 17, _
16, 17, 18, 19, 20, 21, _
20, 21, 22, 23, 24, 25, _
24, 25, 26, 27, 28, 29, _
28, 29, 30, 31, 32, 1)
'Create the expansion array
For i = LBound(vE) To UBound(vE)
m_E(i) = (vE(i) - 1)
Next
'Initialize the PC1 function
vPC1 = Array(57, 49, 41, 33, 25, 17, 9, _
1, 58, 50, 42, 34, 26, 18, _
10, 2, 59, 51, 43, 35, 27, _
19, 11, 3, 60, 52, 44, 36, _
63, 55, 47, 39, 31, 23, 15, _
7, 62, 54, 46, 38, 30, 22, _
14, 6, 61, 53, 45, 37, 29, _
21, 13, 5, 28, 20, 12, 4)
'Create the PC1 function
For i = LBound(vPC1) To UBound(vPC1)
m_PC1(i) = (vPC1(i) - 1)
Next
'Initialize the PC2 function
vPC2 = Array(14, 17, 11, 24, 1, 5, _
3, 28, 15, 6, 21, 10, _
23, 19, 12, 4, 26, 8, _
16, 7, 27, 20, 13, 2, _
41, 52, 31, 37, 47, 55, _
30, 40, 51, 45, 33, 48, _
44, 49, 39, 56, 34, 53, _
46, 42, 50, 36, 29, 32)
'Create the PC2 function
For i = LBound(vPC2) To UBound(vPC2)
m_PC2(i) = (vPC2(i) - 1)
Next
'Initialize the inverted IP
vIPInv = Array(40, 8, 48, 16, 56, 24, 64, 32, _
39, 7, 47, 15, 55, 23, 63, 31, _
38, 6, 46, 14, 54, 22, 62, 30, _
37, 5, 45, 13, 53, 21, 61, 29, _
36, 4, 44, 12, 52, 20, 60, 28, _
35, 3, 43, 11, 51, 19, 59, 27, _
34, 2, 42, 10, 50, 18, 58, 26, _
33, 1, 41, 9, 49, 17, 57, 25)
'Create the inverted IP
For i = LBound(vIPInv) To UBound(vIPInv)
m_IPInv(i) = (vIPInv(i) - 1)
Next
'Initialize permutation P
vP = Array(16, 7, 20, 21, _
29, 12, 28, 17, _
1, 15, 23, 26, _
5, 18, 31, 10, _
2, 8, 24, 14, _
32, 27, 3, 9, _
19, 13, 30, 6, _
22, 11, 4, 25)
'Create P
For i = LBound(vP) To UBound(vP)
m_P(i) = (vP(i) - 1)
Next
'Initialize the leftshifts array
For i = 1 To 16
Select Case i
Case 1, 2, 9, 16
m_LeftShifts(i) = 1
Case Else
m_LeftShifts(i) = 2
End Select
Next
'Initialize the eight s-boxes
vSbox(0) = Array(14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7, _
0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8, _
4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0, _
15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)
vSbox(1) = Array(15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10, _
3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5, _
0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15, _
13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)
vSbox(2) = Array(10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8, _
13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1, _
13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7, _
1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)
vSbox(3) = Array(7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15, _
13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9, _
10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4, _
3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)
vSbox(4) = Array(2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9, _
14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6, _
4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14, _
11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)
vSbox(5) = Array(12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11, _
10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8, _
9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6, _
4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)
vSbox(6) = Array(4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1, _
13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6, _
1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2, _
6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)
vSbox(7) = Array(13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7, _
1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2, _
7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8, _
2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)
Dim lBox As Long
Dim lRow As Long
Dim lColumn As Long
Dim TheByte(0) As Byte
Dim TheBin(0 To 7) As Byte
Dim a As Byte, b As Byte, C As Byte, D As Byte, e As Byte, F As Byte
'Create an optimized version of the s-boxes
'this is not in the standard but much faster
'than calculating the Row/Column index later
For lBox = 0 To 7
For a = 0 To 1
For b = 0 To 1
For C = 0 To 1
For D = 0 To 1
For e = 0 To 1
For F = 0 To 1
lRow = a * 2 + F
lColumn = b * 8 + C * 4 + D * 2 + e
TheByte(0) = vSbox(lBox)(lRow * 16 + lColumn)
Call Byte2Bin(TheByte(), 1, TheBin())
Call CopyMem(m_sBox(lBox, a, b, C, D, e, F), TheBin(4), 4)
Next
Next
Next
Next
Next
Next
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -