📄 clsdes.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsDES"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'DES Encryption/Decryption Class
'------------------------------------
'
'Information concerning the DES
'algorithm can be found at:
'http://csrc.nist.gov/fips/fips46-3.pdf
'
'(c) 2000, Fredrik Qvarfort
'
Option Explicit
'For progress notifications
Event Progress(Percent As Long)
'Key-dependant
Private m_Key(0 To 47, 1 To 16) As Byte
'Buffered key value
Private m_KeyValue As String
'Values given in the DES standard
Private m_E(0 To 63) As Byte
Private m_P(0 To 31) As Byte
Private m_IP(0 To 63) As Byte
Private m_PC1(0 To 55) As Byte
Private m_PC2(0 To 47) As Byte
Private m_IPInv(0 To 63) As Byte
Private m_EmptyArray(0 To 63) As Byte
Private m_LeftShifts(1 To 16) As Byte
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
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Static Sub Byte2Bin(ByteArray() As Byte, ByteLen As Long, BinaryArray() As Byte)
Dim a As Long
Dim ByteValue As Byte
Dim BinLength As Long
'Clear the destination array, faster than
'setting the data to zero in the loop below
Call CopyMem(BinaryArray(0), m_EmptyArray(0), ByteLen * 8)
'Add binary 1's where needed
BinLength = 0
For a = 0 To (ByteLen - 1)
ByteValue = ByteArray(a)
If (ByteValue And 128) Then BinaryArray(BinLength) = 1
If (ByteValue And 64) Then BinaryArray(BinLength + 1) = 1
If (ByteValue And 32) Then BinaryArray(BinLength + 2) = 1
If (ByteValue And 16) Then BinaryArray(BinLength + 3) = 1
If (ByteValue And 8) Then BinaryArray(BinLength + 4) = 1
If (ByteValue And 4) Then BinaryArray(BinLength + 5) = 1
If (ByteValue And 2) Then BinaryArray(BinLength + 6) = 1
If (ByteValue And 1) Then BinaryArray(BinLength + 7) = 1
BinLength = BinLength + 8
Next
End Sub
Private Static Sub Bin2Byte(BinaryArray() As Byte, ByteLen As Long, ByteArray() As Byte)
Dim a As Long
Dim ByteValue As Byte
Dim BinLength As Long
'Calculate byte values
BinLength = 0
For a = 0 To (ByteLen - 1)
ByteValue = 0
If (BinaryArray(BinLength) = 1) Then ByteValue = ByteValue + 128
If (BinaryArray(BinLength + 1) = 1) Then ByteValue = ByteValue + 64
If (BinaryArray(BinLength + 2) = 1) Then ByteValue = ByteValue + 32
If (BinaryArray(BinLength + 3) = 1) Then ByteValue = ByteValue + 16
If (BinaryArray(BinLength + 4) = 1) Then ByteValue = ByteValue + 8
If (BinaryArray(BinLength + 5) = 1) Then ByteValue = ByteValue + 4
If (BinaryArray(BinLength + 6) = 1) Then ByteValue = ByteValue + 2
If (BinaryArray(BinLength + 7) = 1) Then ByteValue = ByteValue + 1
ByteArray(a) = ByteValue
BinLength = BinLength + 8
Next
End Sub
Private Static Sub EncryptBlock(BlockData() As Byte)
Dim a As Long
Dim i As Long
Dim L(0 To 31) As Byte
Dim R(0 To 31) As Byte
Dim RL(0 To 63) As Byte
Dim sBox(0 To 31) As Byte
Dim LiRi(0 To 31) As Byte
Dim ERxorK(0 To 47) As Byte
Dim BinBlock(0 To 63) As Byte
'Convert the block into a binary array
'(I do believe this is the best solution
'in VB for the DES algorithm, but it is
'still slow as xxxx)
Call Byte2Bin(BlockData(), 8, BinBlock())
'Apply the IP permutation and split the
'block into two halves, L[] and R[]
For a = 0 To 31
L(a) = BinBlock(m_IP(a))
R(a) = BinBlock(m_IP(a + 32))
Next
'Apply the 16 subkeys on the block
For i = 1 To 16
'E(R[i]) xor K[i]
ERxorK(0) = R(31) Xor m_Key(0, i)
ERxorK(1) = R(0) Xor m_Key(1, i)
ERxorK(2) = R(1) Xor m_Key(2, i)
ERxorK(3) = R(2) Xor m_Key(3, i)
ERxorK(4) = R(3) Xor m_Key(4, i)
ERxorK(5) = R(4) Xor m_Key(5, i)
ERxorK(6) = R(3) Xor m_Key(6, i)
ERxorK(7) = R(4) Xor m_Key(7, i)
ERxorK(8) = R(5) Xor m_Key(8, i)
ERxorK(9) = R(6) Xor m_Key(9, i)
ERxorK(10) = R(7) Xor m_Key(10, i)
ERxorK(11) = R(8) Xor m_Key(11, i)
ERxorK(12) = R(7) Xor m_Key(12, i)
ERxorK(13) = R(8) Xor m_Key(13, i)
ERxorK(14) = R(9) Xor m_Key(14, i)
ERxorK(15) = R(10) Xor m_Key(15, i)
ERxorK(16) = R(11) Xor m_Key(16, i)
ERxorK(17) = R(12) Xor m_Key(17, i)
ERxorK(18) = R(11) Xor m_Key(18, i)
ERxorK(19) = R(12) Xor m_Key(19, i)
ERxorK(20) = R(13) Xor m_Key(20, i)
ERxorK(21) = R(14) Xor m_Key(21, i)
ERxorK(22) = R(15) Xor m_Key(22, i)
ERxorK(23) = R(16) Xor m_Key(23, i)
ERxorK(24) = R(15) Xor m_Key(24, i)
ERxorK(25) = R(16) Xor m_Key(25, i)
ERxorK(26) = R(17) Xor m_Key(26, i)
ERxorK(27) = R(18) Xor m_Key(27, i)
ERxorK(28) = R(19) Xor m_Key(28, i)
ERxorK(29) = R(20) Xor m_Key(29, i)
ERxorK(30) = R(19) Xor m_Key(30, i)
ERxorK(31) = R(20) Xor m_Key(31, i)
ERxorK(32) = R(21) Xor m_Key(32, i)
ERxorK(33) = R(22) Xor m_Key(33, i)
ERxorK(34) = R(23) Xor m_Key(34, i)
ERxorK(35) = R(24) Xor m_Key(35, i)
ERxorK(36) = R(23) Xor m_Key(36, i)
ERxorK(37) = R(24) Xor m_Key(37, i)
ERxorK(38) = R(25) Xor m_Key(38, i)
ERxorK(39) = R(26) Xor m_Key(39, i)
ERxorK(40) = R(27) Xor m_Key(40, i)
ERxorK(41) = R(28) Xor m_Key(41, i)
ERxorK(42) = R(27) Xor m_Key(42, i)
ERxorK(43) = R(28) Xor m_Key(43, i)
ERxorK(44) = R(29) Xor m_Key(44, i)
ERxorK(45) = R(30) Xor m_Key(45, i)
ERxorK(46) = R(31) Xor m_Key(46, i)
ERxorK(47) = R(0) Xor m_Key(47, i)
'Apply the s-boxes
Call CopyMem(sBox(0), m_sBox(0, ERxorK(0), ERxorK(1), ERxorK(2), ERxorK(3), ERxorK(4), ERxorK(5)), 4)
Call CopyMem(sBox(4), m_sBox(1, ERxorK(6), ERxorK(7), ERxorK(8), ERxorK(9), ERxorK(10), ERxorK(11)), 4)
Call CopyMem(sBox(8), m_sBox(2, ERxorK(12), ERxorK(13), ERxorK(14), ERxorK(15), ERxorK(16), ERxorK(17)), 4)
Call CopyMem(sBox(12), m_sBox(3, ERxorK(18), ERxorK(19), ERxorK(20), ERxorK(21), ERxorK(22), ERxorK(23)), 4)
Call CopyMem(sBox(16), m_sBox(4, ERxorK(24), ERxorK(25), ERxorK(26), ERxorK(27), ERxorK(28), ERxorK(29)), 4)
Call CopyMem(sBox(20), m_sBox(5, ERxorK(30), ERxorK(31), ERxorK(32), ERxorK(33), ERxorK(34), ERxorK(35)), 4)
Call CopyMem(sBox(24), m_sBox(6, ERxorK(36), ERxorK(37), ERxorK(38), ERxorK(39), ERxorK(40), ERxorK(41)), 4)
Call CopyMem(sBox(28), m_sBox(7, ERxorK(42), ERxorK(43), ERxorK(44), ERxorK(45), ERxorK(46), ERxorK(47)), 4)
'L[i] xor P(R[i])
LiRi(0) = L(0) Xor sBox(15)
LiRi(1) = L(1) Xor sBox(6)
LiRi(2) = L(2) Xor sBox(19)
LiRi(3) = L(3) Xor sBox(20)
LiRi(4) = L(4) Xor sBox(28)
LiRi(5) = L(5) Xor sBox(11)
LiRi(6) = L(6) Xor sBox(27)
LiRi(7) = L(7) Xor sBox(16)
LiRi(8) = L(8) Xor sBox(0)
LiRi(9) = L(9) Xor sBox(14)
LiRi(10) = L(10) Xor sBox(22)
LiRi(11) = L(11) Xor sBox(25)
LiRi(12) = L(12) Xor sBox(4)
LiRi(13) = L(13) Xor sBox(17)
LiRi(14) = L(14) Xor sBox(30)
LiRi(15) = L(15) Xor sBox(9)
LiRi(16) = L(16) Xor sBox(1)
LiRi(17) = L(17) Xor sBox(7)
LiRi(18) = L(18) Xor sBox(23)
LiRi(19) = L(19) Xor sBox(13)
LiRi(20) = L(20) Xor sBox(31)
LiRi(21) = L(21) Xor sBox(26)
LiRi(22) = L(22) Xor sBox(2)
LiRi(23) = L(23) Xor sBox(8)
LiRi(24) = L(24) Xor sBox(18)
LiRi(25) = L(25) Xor sBox(12)
LiRi(26) = L(26) Xor sBox(29)
LiRi(27) = L(27) Xor sBox(5)
LiRi(28) = L(28) Xor sBox(21)
LiRi(29) = L(29) Xor sBox(10)
LiRi(30) = L(30) Xor sBox(3)
LiRi(31) = L(31) Xor sBox(24)
'Prepare for next round
Call CopyMem(L(0), R(0), 32)
Call CopyMem(R(0), LiRi(0), 32)
Next
'Concatenate R[]L[]
Call CopyMem(RL(0), R(0), 32)
Call CopyMem(RL(32), L(0), 32)
'Apply the invIP permutation
For a = 0 To 63
BinBlock(a) = RL(m_IPInv(a))
Next
'Convert the binaries into a byte array
Call Bin2Byte(BinBlock(), 8, BlockData())
End Sub
Private Static Sub DecryptBlock(BlockData() As Byte)
Dim a As Long
Dim i As Long
Dim L(0 To 31) As Byte
Dim R(0 To 31) As Byte
Dim RL(0 To 63) As Byte
Dim sBox(0 To 31) As Byte
Dim LiRi(0 To 31) As Byte
Dim ERxorK(0 To 47) As Byte
Dim BinBlock(0 To 63) As Byte
'Convert the block into a binary array
'(I do believe this is the best solution
'in VB for the DES algorithm, but it is
'still slow as xxxx)
Call Byte2Bin(BlockData(), 8, BinBlock())
'Apply the IP permutation and split the
'block into two halves, L[] and R[]
For a = 0 To 31
L(a) = BinBlock(m_IP(a))
R(a) = BinBlock(m_IP(a + 32))
Next
'Apply the 16 subkeys on the block
For i = 16 To 1 Step -1
'E(R[i]) xor K[i]
ERxorK(0) = R(31) Xor m_Key(0, i)
ERxorK(1) = R(0) Xor m_Key(1, i)
ERxorK(2) = R(1) Xor m_Key(2, i)
ERxorK(3) = R(2) Xor m_Key(3, i)
ERxorK(4) = R(3) Xor m_Key(4, i)
ERxorK(5) = R(4) Xor m_Key(5, i)
ERxorK(6) = R(3) Xor m_Key(6, i)
ERxorK(7) = R(4) Xor m_Key(7, i)
ERxorK(8) = R(5) Xor m_Key(8, i)
ERxorK(9) = R(6) Xor m_Key(9, i)
ERxorK(10) = R(7) Xor m_Key(10, i)
ERxorK(11) = R(8) Xor m_Key(11, i)
ERxorK(12) = R(7) Xor m_Key(12, i)
ERxorK(13) = R(8) Xor m_Key(13, i)
ERxorK(14) = R(9) Xor m_Key(14, i)
ERxorK(15) = R(10) Xor m_Key(15, i)
ERxorK(16) = R(11) Xor m_Key(16, i)
ERxorK(17) = R(12) Xor m_Key(17, i)
ERxorK(18) = R(11) Xor m_Key(18, i)
ERxorK(19) = R(12) Xor m_Key(19, i)
ERxorK(20) = R(13) Xor m_Key(20, i)
ERxorK(21) = R(14) Xor m_Key(21, i)
ERxorK(22) = R(15) Xor m_Key(22, i)
ERxorK(23) = R(16) Xor m_Key(23, i)
ERxorK(24) = R(15) Xor m_Key(24, i)
ERxorK(25) = R(16) Xor m_Key(25, i)
ERxorK(26) = R(17) Xor m_Key(26, i)
ERxorK(27) = R(18) Xor m_Key(27, i)
ERxorK(28) = R(19) Xor m_Key(28, i)
ERxorK(29) = R(20) Xor m_Key(29, i)
ERxorK(30) = R(19) Xor m_Key(30, i)
ERxorK(31) = R(20) Xor m_Key(31, i)
ERxorK(32) = R(21) Xor m_Key(32, i)
ERxorK(33) = R(22) Xor m_Key(33, i)
ERxorK(34) = R(23) Xor m_Key(34, i)
ERxorK(35) = R(24) Xor m_Key(35, i)
ERxorK(36) = R(23) Xor m_Key(36, i)
ERxorK(37) = R(24) Xor m_Key(37, i)
ERxorK(38) = R(25) Xor m_Key(38, i)
ERxorK(39) = R(26) Xor m_Key(39, i)
ERxorK(40) = R(27) Xor m_Key(40, i)
ERxorK(41) = R(28) Xor m_Key(41, i)
ERxorK(42) = R(27) Xor m_Key(42, i)
ERxorK(43) = R(28) Xor m_Key(43, i)
ERxorK(44) = R(29) Xor m_Key(44, i)
ERxorK(45) = R(30) Xor m_Key(45, i)
ERxorK(46) = R(31) Xor m_Key(46, i)
ERxorK(47) = R(0) Xor m_Key(47, i)
'Apply the s-boxes
Call CopyMem(sBox(0), m_sBox(0, ERxorK(0), ERxorK(1), ERxorK(2), ERxorK(3), ERxorK(4), ERxorK(5)), 4)
Call CopyMem(sBox(4), m_sBox(1, ERxorK(6), ERxorK(7), ERxorK(8), ERxorK(9), ERxorK(10), ERxorK(11)), 4)
Call CopyMem(sBox(8), m_sBox(2, ERxorK(12), ERxorK(13), ERxorK(14), ERxorK(15), ERxorK(16), ERxorK(17)), 4)
Call CopyMem(sBox(12), m_sBox(3, ERxorK(18), ERxorK(19), ERxorK(20), ERxorK(21), ERxorK(22), ERxorK(23)), 4)
Call CopyMem(sBox(16), m_sBox(4, ERxorK(24), ERxorK(25), ERxorK(26), ERxorK(27), ERxorK(28), ERxorK(29)), 4)
Call CopyMem(sBox(20), m_sBox(5, ERxorK(30), ERxorK(31), ERxorK(32), ERxorK(33), ERxorK(34), ERxorK(35)), 4)
Call CopyMem(sBox(24), m_sBox(6, ERxorK(36), ERxorK(37), ERxorK(38), ERxorK(39), ERxorK(40), ERxorK(41)), 4)
Call CopyMem(sBox(28), m_sBox(7, ERxorK(42), ERxorK(43), ERxorK(44), ERxorK(45), ERxorK(46), ERxorK(47)), 4)
'L[i] xor P(R[i])
LiRi(0) = L(0) Xor sBox(15)
LiRi(1) = L(1) Xor sBox(6)
LiRi(2) = L(2) Xor sBox(19)
LiRi(3) = L(3) Xor sBox(20)
LiRi(4) = L(4) Xor sBox(28)
LiRi(5) = L(5) Xor sBox(11)
LiRi(6) = L(6) Xor sBox(27)
LiRi(7) = L(7) Xor sBox(16)
LiRi(8) = L(8) Xor sBox(0)
LiRi(9) = L(9) Xor sBox(14)
LiRi(10) = L(10) Xor sBox(22)
LiRi(11) = L(11) Xor sBox(25)
LiRi(12) = L(12) Xor sBox(4)
LiRi(13) = L(13) Xor sBox(17)
LiRi(14) = L(14) Xor sBox(30)
LiRi(15) = L(15) Xor sBox(9)
LiRi(16) = L(16) Xor sBox(1)
LiRi(17) = L(17) Xor sBox(7)
LiRi(18) = L(18) Xor sBox(23)
LiRi(19) = L(19) Xor sBox(13)
LiRi(20) = L(20) Xor sBox(31)
LiRi(21) = L(21) Xor sBox(26)
LiRi(22) = L(22) Xor sBox(2)
LiRi(23) = L(23) Xor sBox(8)
LiRi(24) = L(24) Xor sBox(18)
LiRi(25) = L(25) Xor sBox(12)
LiRi(26) = L(26) Xor sBox(29)
LiRi(27) = L(27) Xor sBox(5)
LiRi(28) = L(28) Xor sBox(21)
LiRi(29) = L(29) Xor sBox(10)
LiRi(30) = L(30) Xor sBox(3)
LiRi(31) = L(31) Xor sBox(24)
'Prepare for next round
Call CopyMem(L(0), R(0), 32)
Call CopyMem(R(0), LiRi(0), 32)
Next
'Concatenate R[]L[]
Call CopyMem(RL(0), R(0), 32)
Call CopyMem(RL(32), L(0), 32)
'Apply the invIP permutation
For a = 0 To 63
BinBlock(a) = RL(m_IPInv(a))
Next
'Convert the binaries into a byte array
Call Bin2Byte(BinBlock(), 8, BlockData())
End Sub
Public Sub EncryptByte(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 key if provided
If (Len(Key) > 0) Then Me.Key = Key
'Get the size of the original array
OrigLen = UBound(ByteArray) + 1
'First we add 12 bytes (4 bytes for the
'length and 8 bytes for the seed values
'for the CBC routine), and the ciphertext
'must be a multiple of 8 bytes
CipherLen = OrigLen + 12
If (CipherLen Mod 8 <> 0) Then
CipherLen = CipherLen + 8 - (CipherLen Mod 8)
End If
ReDim Preserve ByteArray(CipherLen - 1)
Call CopyMem(ByteArray(12), ByteArray(0), OrigLen)
'Store the length descriptor in bytes [9-12]
Call CopyMem(ByteArray(8), OrigLen, 4)
'Store a block of random data in bytes [1-8],
'these work as seed values for the CBC routine
'and is used to produce different ciphertext
'even when encrypting the same data with the
'same key)
Call Randomize
Call CopyMem(ByteArray(0), CLng(2147483647 * Rnd), 4)
Call CopyMem(ByteArray(4), CLng(2147483647 * Rnd), 4)
'Encrypt the data in 64-bit blocks
For Offset = 0 To (CipherLen - 1) Step 8
'Get the next block of plaintext
Call CopyMem(CurrBlock(0), ByteArray(Offset), 8)
'XOR the plaintext with the previous
'ciphertext (CBC, Cipher-Block Chaining)
For a = 0 To 7
CurrBlock(a) = CurrBlock(a) Xor CipherBlock(a)
Next
'Encrypt the block
Call EncryptBlock(CurrBlock())
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -