可用的DES加密函数

Question

大家有没有能用的DES算法加密函数的,网上看了几个,有一个张新扬写的类,加解密都没有问题,却不知如何对设定密钥,以下是代码,大家看看,或贴一下自己能用的代码,谢谢    '************************************************************************
    '*
    '*
    '* DES/3DES 加解密类模块 V1.0
    '*
    '* 开发:张新扬
    '* 2005.08.24
    '*
    '*
    '************************************************************************
     
     
     
    '
    '======= 私有变量 =======
     
    Private IP(63) As Byte, IP_1(63) As Byte, E(47) As Byte '数据变换
    Private PC_1(55) As Integer, PC_2(47) As Integer, ccmovebit(15) As Integer '密钥生成
    Private P(31) As Byte, ss(7, 3, 15) As Byte 'S变换
    Private key_n1(15, 7) As Byte '密钥1
    Private key_n2(15, 7) As Byte '密钥2
     
    '
    '======= API =========
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
     
     
    '
    '***************************************************************
    '
    '==================== 下面是类的函数及方法 ===================
    '
    '***************************************************************
     
     
     
     
     
     
    '==========================================================================================
    ' SetKey 函数说明：
    ' 设置3DES加/解密的密钥
    ' 返回：
    ' 无
    ' 参数：
    ' K_Bit() AS Byte 密钥,不少于16个元素
    '==========================================================================================
    Sub SetKey(K_Bit() As Byte)
     Dim Key() As Byte
     Dim K_Bit1(7) As Byte
     Dim K_Bit2(7) As Byte
     
     Key = K_Bit
     ReDim Preserve Key(15) As Byte
     
     
     CopyMemory K_Bit1(0), Key(0), 8
     CopyMemory K_Bit2(0), Key(8), 8
     
     '//根据密钥生成16个子密钥
     GenSubKey K_Bit1(), key_n1()
     GenSubKey K_Bit2(), key_n2()
    End Sub
     
     
    '==========================================================================================
    ' SetKey1 函数说明：
    ' 设置3DES加/解密的的第一个密钥
    ' 返回：
    ' 无
    ' 参数：
    ' K_Bit() AS Byte 密钥,不少于8个元素
    '==========================================================================================
    Sub SetKey1(K_Bit() As Byte)
     '//根据密钥生成16个子密钥
     Dim Key() As Byte
     Key = K_Bit
     ReDim Preserve Key(7) As Byte
     GenSubKey Key(), key_n1()
    End Sub
     
     
     
    '=========================================================================================
    ' SetKey2 函数说明：
    ' 设置3DES加/解密的的第二个密钥
    ' 返回：
    ' 无
    ' 参数：
    ' K_Bit() AS Byte 密钥,不少于8个元素
    '==========================================================================================
    Sub SetKey2(K_Bit() As Byte)
     '//根据密钥生成16个子密钥
     Dim Key() As Byte
     Key = K_Bit
     
     ReDim Preserve Key(7) As Byte
     GenSubKey Key(), key_n2()
    End Sub
     
     
     
    '==========================================================================================
    ' Encrypt3Des_ArrToArr 函数说明：
    ' 3DES加/解密
    ' 返回：
    ' 无
    ' 参数：
    ' m_bit() As Byte 输入
    ' e_bit() As Byte 输出 ,元素个数为8的倍数
    ' bFlag As Byte 可选输入,为2则解密,其它或为缺省时为加密
    '==========================================================================================
    Sub Encrypt3Des_ArrToArr(m_bit() As Byte, e_bit() As Byte, Optional bFlag As Byte = 1)
     Dim i As Integer
     Dim ina() As Byte, outa() As Byte
     
     ina = m_bit
     EncryptDes_ArrToArr ina(), outa(), 1, bFlag
     ina = outa
     EncryptDes_ArrToArr ina(), outa(), 2, 3 - bFlag
     ina = outa
     EncryptDes_ArrToArr ina(), outa(), 1, bFlag
     ReDim e_bit(UBound(outa)) As Byte
     'For i = 0 To UBound(outa)
     ' e_bit(i) = outa(i)
     'Next
     CopyMemory e_bit(0), outa(0), UBound(outa) + 1
     
    End Sub
     
     
      

Answer 1

    '==========================================================================================
    ' EncryptDes_ArrToArr 函数说明：
    ' DES加/解密
    ' 返回：
    ' 无
    ' 参数：
    ' m_bit() As Byte 输入
    ' e_bit() As Byte 输出 ,元素个数为8的倍数
    ' bUseKeyNo As Byte 可选输入,为2则使用第二个密钥加/解密，否则使用第一个密钥加/解密
    ' bFlag As Byte 可选输入,为2则解密,否则加密
    '==========================================================================================
    Sub EncryptDes_ArrToArr(m_bit() As Byte, e_bit() As Byte, Optional bUseKeyNo As Byte = 1, Optional bFlag As Byte = 1)
     Dim iSL As Integer
     Dim ina(7) As Byte
     Dim lPos As Long
     Dim outa(7) As Byte
     Dim L As Long, M As Long
     Dim i As Long
     
     If bUseKeyNo <> 2 Then bUseKeyNo = 1
     
     iSL = UBound(m_bit) + 1
     If iSL Mod 8 <> 0 Then
     iSL = ((iSL \ 8) + 1) * 8
     End If
     
     ReDim e_bit(iSL - 1) As Byte
     L = 0
     Do While L <= UBound(m_bit)
     M = L + 7
     If M > UBound(m_bit) Then M = UBound(m_bit)
     For i = 0 To 7
     ina(i) = 0
     Next
     For i = L To M
     ina(i - L) = m_bit(i)
     Next
     
     
     endes1 ina(), outa(), bUseKeyNo, bFlag
     
     
     For i = 0 To 7
     e_bit(i + L) = outa(i)
     Next
     L = L + 8
     Loop
    End Sub
     
    '
    '***************************************************************
    '
    '==================== 下面是私有函数及过程 ===================
    '
    '***************************************************************
     
     
    '
    '* ArrXor 函数说明：
    '* 将输入的两个数组中的字节元素分别作异或运算
    '* 返回：
    '* 无
    '* 参数：'
    '* const BYTE in1[] 输入字符串1
    '* const BYTE in2[] 输入字符串2
    '* BYTE out[] 输出的结果字符串
    '*/
    Private Sub ArrXor(in1() As Byte, in2() As Byte, outa() As Byte)
     Dim i As Integer
     For i = 0 To UBound(in1)
     outa(i) = in1(i) Xor in2(i)
     Next
    End Sub
     
    '/*
    ' * Bin2ASCII 函数说明：
    ' * 将64字节的01字符串转换成对应的8个字节
    ' * 返回：
    ' * 转换后结果的指针
    ' * 参数：
    ' * const BYTE abyte(64) 输入字符串
    ' * BYTE bit(8) 输出的转换结果
    ' */
    Private Sub Bin2ASCII(abyte() As Byte, bit() As Byte)
     Dim i As Integer
     For i = 0 To 7
     bit(i) = abyte(i * 8) * 128 + abyte(i * 8 + 1) * 64 + _
     abyte(i * 8 + 2) * 32 + abyte(i * 8 + 3) * 16 + _
     abyte(i * 8 + 4) * 8 + abyte(i * 8 + 5) * 4 + _
     abyte(i * 8 + 6) * 2 + abyte(i * 8 + 7)
     Next
    End Sub
     
    '/*
    ' * ASCII2Bin 函数说明：
    ' * 将8个字节输入转换成对应的64字节的01字符串
    ' * 返回：
    ' * 转换后结果的指针
    ' * 参数：
    ' * const BYTE bit[8] 输入字符串
    ' * BYTE byte[64] 输出的转换结果
    ' */
    Private Sub ASCII2Bin(bit() As Byte, abyte() As Byte)
     Dim i As Integer, j As Integer
     For i = 0 To 7
     For j = 0 To 7
     abyte(i * 8 + j) = (bit(i) \ (2 ^ (7 - j))) And &H1
     Next
     Next
    End Sub
     
    '/*
    ' * GenSubKey 函数说明：
    ' * 由输入的密钥得到16个子密钥
    ' * 返回：
    ' * 无
    ' * 参数：
    ' * const BYTE oldkey[8] 输入密钥
    ' * BYTE newkey[16][8] 输出的子密钥
    ' */
    Private Sub GenSubKey(oldkey() As Byte, newkey() As Byte)
     Dim i As Integer, k As Integer, rol As Integer
     Dim S As String
     
     Dim oldkey_byte(63) As Byte ' BYTE oldkey_byte[64];
     Dim oldkey_byte1(63) As Byte ' BYTE oldkey_byte1[64];
     Dim oldkey_byte2(63) As Byte ' BYTE oldkey_byte2[64];
     Dim oldkey_c(55) As Byte ' BYTE oldkey_c[56];
     Dim oldkey_d(55) As Byte ' BYTE oldkey_d[56];
     Dim newkey_byte(15, 63) As Byte ' BYTE newkey_byte[16][64];
     Dim aT
     Dim abyte(63) As Byte, bbyte(7) As Byte
     
     rol = 0
     
     
     
     ASCII2Bin oldkey(), oldkey_byte()
     
     '//位变换--根据换位表换位 压缩成56位密码
     'for(i = 0; i < 56; i++)
     ' oldkey_byte1[i] = oldkey_byte[pc_1[i] - 1];
     
     For i = 0 To 55
     oldkey_byte1(i) = oldkey_byte(PC_1(i) - 1)
     Next
     
     
     
     '//分为左右两部分，复制一遍以便于循环左移
     'for(i = 0; i < 28; i++)
     ' oldkey_c[i] = oldkey_byte1[i], oldkey_c[i + 28] = oldkey_byte1[i],
     ' oldkey_d[i] = oldkey_byte1[i + 28], oldkey_d[i + 28] = oldkey_byte1[i + 28];
     
     'For i = 0 To 27
     ' oldkey_c(i) = oldkey_byte1(i)
     ' oldkey_c(i + 28) = oldkey_byte1(i)
     ' oldkey_d(i) = oldkey_byte1(i + 28)
     ' oldkey_d(i + 28) = oldkey_byte1(i + 28)
     'Next
     CopyMemory oldkey_c(0), oldkey_byte1(0), 28
     CopyMemory oldkey_c(28), oldkey_byte1(0), 28
     CopyMemory oldkey_d(0), oldkey_byte1(28), 28
     CopyMemory oldkey_d(28), oldkey_byte1(28), 28
     
     '//分别生成16个子密钥
     'for(i = 0; i < 16; i++)
     '{
     ' //循环左移
     ' rol += ccmovebit[i];
     ' //合并左移后的结果
     ' for(k = 0; k < 28; k++)
     ' oldkey_byte2[k] = oldkey_c[k + rol], oldkey_byte2[k + 28] = oldkey_d[k + rol];
     ' //位变换
     ' for(k = 0; k < 48; k++)
     ' newkey_byte[i][k] = oldkey_byte2[pc_2[k] - 1];
     '}
     For i = 0 To 15
     '循环左移
     rol = rol + ccmovebit(i)
     '合并左移后的结果
     'For k = 0 To 27
     ' oldkey_byte2(k) = oldkey_c(k + rol)
     ' oldkey_byte2(k + 28) = oldkey_d(k + rol)
     'Next
     
     CopyMemory oldkey_byte2(0), oldkey_c(rol), 28
     CopyMemory oldkey_byte2(28), oldkey_d(rol), 28
     
     '位变换
     For k = 0 To 47
     newkey_byte(i, k) = oldkey_byte2(PC_2(k) - 1)
     Next
     Next
     
     '生成最终结果
     'for(i = 0; i < 16; i++)
     ' Bin2ASCII(newkey_byte[i], newkey[i]);
     For i = 0 To 15
     For k = 0 To 63
     abyte(k) = newkey_byte(i, k)
     Next
     
     
     
     Bin2ASCII abyte(), bbyte()
     For k = 0 To 7
     newkey(i, k) = bbyte(k)
     Next
     Next
    End Sub
     
    

Answer 2

    '/*
    ' * endes1 函数说明：
    ' * DES加密
    ' * 返回：
    ' * 无
    ' * 参数：
    ' * const BYTE m_bit[8] 输入的原文
    ' * const BYTE k_bit[8] 输入的密钥
    ' * BYTE e_bit[8] 输出的密文
    ' bFlag=1 加 =2解
    ' */
    Private Sub endes1(m_bit() As Byte, e_bit() As Byte, Optional bUseKeyNo As Byte = 1, Optional bFlag As Byte = 1)
     
     Dim S As String
     
     Dim m_bit1(7) As Byte ' BYTE m_bit1[8] = {0};
     Dim m_byte(63) As Byte ' BYTE m_byte[64] = {0};
     Dim m_byte1(63) As Byte ' BYTE m_byte1[64] = {0};
     'Dim key_n(15, 7) As Byte ' BYTE key_n[16][8] = {0};
     Dim l_bit(16, 7) As Byte ' BYTE l_bit[17][8] = {0};
     Dim r_bit(16, 7) As Byte ' BYTE r_bit[17][8] = {0};
     Dim e_byte(63) As Byte ' BYTE e_byte[64] = {0};
     Dim e_byte1(63) As Byte ' BYTE e_byte1[64] = {0};
     Dim r_byte(63) As Byte ' BYTE r_byte[64] = {0};
     Dim r_byte1(63) As Byte ' BYTE r_byte1[64] = {0};
     Dim key_n
     
     Dim l_bit0(7) As Byte, r_bit0(7) As Byte
     Dim l_bit1(7) As Byte, r_bit1(7) As Byte
     
     Dim abyte8(7) As Byte
     
     
     Dim i As Integer, j As Integer, k As Integer
     
     If bUseKeyNo <> 2 Then bUseKeyNo = 1
     
     If bUseKeyNo = 1 Then key_n = key_n1 Else key_n = key_n2
     
     
     '//根据密钥生成16个子密钥
     'GenSubKey k_bit(), key_n()
     
     '//将待加密字串变换成01串
     ASCII2Bin m_bit(), m_byte()
     
     '//按照ip表对待加密字串进行位变换
     'for(i = 0; i < 64; i++)
     ' m_byte1[i] = m_byte[ip[i] - 1];
     For i = 0 To 63
     m_byte1(i) = m_byte(IP(i) - 1)
     Next
     
     '位变换后的待加密字串
     Bin2ASCII m_byte1(), m_bit1()
     
     '//将位变换后的待加密字串分成两组，分别为前4字节L和后4字节R，作为迭代的基础（第0次迭代）
     'for(i = 0; i < 4; i++)
     ' l_bit[0][i] = m_bit1[i], r_bit[0][i] = m_bit1[i + 4];
     For i = 0 To 3
     'l_bit(0, i) = m_bit1(i)
     'r_bit(0, i) = m_bit1(i + 4)
     CopyMemory l_bit0(0), m_bit1(0), 4
     CopyMemory r_bit0(0), m_bit1(4), 4
     Next
     
     '//16次迭代运算
     'for(i = 1; i <= 16; i++)
     
     For i = 1 To 16
     '//R的上一次的迭代结果作为L的当前次迭代结果
     'for(j = 0; j < 4; j++)
     ' l_bit[i][j] = r_bit[i-1][j];
     'For j = 0 To 3
     ' l_bit(i, j) = r_bit(i - 1, j)
     'Next
     CopyMemory l_bit1(0), r_bit0(0), 4
     
     'ASCII2Bin(r_bit[i-1], r_byte);
     'For j = 0 To 7
     ' abyte8(j) = r_bit(i - 1, j)
     'Next
     CopyMemory abyte8(0), r_bit0(0), 8
     
     ASCII2Bin abyte8(), r_byte()
     
     '//将R的上一次迭代结果按E表进行位扩展得到48位中间结果
     'for(j = 0; j < 48; j++)
     ' r_byte1[j] = r_byte[e[j] - 1];
     'Bin2ASCII(r_byte1, r_bit[i-1]);
     For j = 0 To 47
     r_byte1(j) = r_byte(E(j) - 1)
     Next
     Bin2ASCII r_byte1(), abyte8()
     'For j = 0 To 7
     ' r_bit(i - 1, j) = abyte8(j)
     'Next
     CopyMemory r_bit0(0), abyte8(0), 8
     
     '//与第I-1个子密钥进行异或运算
     'for(j = 0; j < 6; j++)
     ' r_bit[i-1][j] = r_bit[i-1][j] ^ key_n[i-1][j];
     For j = 0 To 5
     If bFlag = 1 Then
     '加
     'r_bit(i - 1, j) = r_bit(i - 1, j) Xor key_n(i - 1, j)
     r_bit0(j) = r_bit0(j) Xor key_n(i - 1, j)
     Else
     '解
     'r_bit(i - 1, j) = r_bit(i - 1, j) Xor key_n((17 - i) - 1, j)
     r_bit0(j) = r_bit0(j) Xor key_n((17 - i) - 1, j)
     End If
     Next
     
     '//进行S选择，得到32位中间结果
     'SReplace(r_bit[i - 1]);
     'For j = 0 To 7
     ' abyte8(j) = r_bit(i - 1, j)
     'Next
     CopyMemory abyte8(0), r_bit0(0), 8
     
     SReplace abyte8()
     'For j = 0 To 7
     ' r_bit(i - 1, j) = abyte8(j)
     'Next
     CopyMemory r_bit0(0), abyte8(0), 8
     
     '//结果与L的上次迭代结果异或得到R的此次迭代结果
     'for(j = 0; j < 4; j++)
     '{
     ' r_bit[i][j] = l_bit[i-1][j] ^ r_bit[i-1][j];
     '}
     For j = 0 To 3
     'r_bit(i, j) = l_bit(i - 1, j) Xor r_bit(i - 1, j)
     r_bit1(j) = l_bit0(j) Xor r_bit0(j)
     Next
     
     CopyMemory l_bit0(0), l_bit1(0), 8
     CopyMemory r_bit0(0), r_bit1(0), 8
     Next
     
     
     '//组合最终迭代结果
     'for(i = 0; i < 4; i++)
     ' e_bit[i] = r_bit[16][i], e_bit[i + 4] = l_bit[16][i];
     'For i = 0 To 3
     ' e_bit(i) = r_bit(16, i)
     ' e_bit(i + 4) = l_bit(16, i)
     'Next
     CopyMemory e_bit(0), r_bit1(0), 4
     CopyMemory e_bit(4), l_bit1(0), 4
     
     ASCII2Bin e_bit(), e_byte()
     
     '//按照表IP-1进行位变换
     'for(i = 0; i < 64; i++)
     ' e_byte1[i] = e_byte[ip_1[i] - 1];
     For i = 0 To 63
     e_byte1(i) = e_byte(IP_1(i) - 1)
     Next
     
     '//得到最后的加密结果
     Bin2ASCII e_byte1(), e_bit()
    End Sub
     
     
     
     
 

Answer 3

   '/*
    ' * SReplace 函数说明：
    ' * S选择
    ' * 返回：
    ' * 无
    ' * 参数：
    ' * BYTE s_bit[8] 输入暨选择后的输出
    ' */
    Private Sub SReplace(s_bit() As Byte)
     
     Dim i As Integer
     
     
     Dim s_byte(63) As Byte ' BYTE s_byte[64] = {0};
     Dim s_byte1(63) As Byte ' BYTE s_byte1[64] = {0};
     Dim row As Byte, col As Byte
     Dim s_out_bit(7) As Byte 'BYTE s_out_bit[8] = {0};
     
     
     
     
     row = 0: col = 0
     
     '//转成二进制字符串处理
     ASCII2Bin s_bit(), s_byte()
     'for(int i = 0; i < 8; i++)
     '{
     ' //0、5位为row，1、2、3、4位为col，在S表中选择一个八位的数
     ' row = s_byte[i * 6] * 2 + s_byte[i * 6 + 5];
     ' col = s_byte[i * 6 + 1] * 8 + s_byte[i * 6 + 2] * 4 + s_byte[i * 6 + 3] * 2 + s_byte[i * 6 + 4];
     ' s_out_bit[i] = s[i][row][col];
     '}
     For i = 0 To 7
     '0、5位为row，1、2、3、4位为col，在S表中选择一个八位的数
     row = s_byte(i * 6) * 2 + s_byte(i * 6 + 5)
     col = s_byte(i * 6 + 1) * 8 + s_byte(i * 6 + 2) * 4 + s_byte(i * 6 + 3) * 2 + s_byte(i * 6 + 4)
     s_out_bit(i) = ss(i, row, col)
     Next
     
     '//将八个选择的八位数据压缩表示
     's_out_bit[0] = (s_out_bit[0] << 4) + s_out_bit[1];
     's_out_bit[1] = (s_out_bit[2] << 4) + s_out_bit[3];
     's_out_bit[2] = (s_out_bit[4] << 4) + s_out_bit[5];
     's_out_bit[3] = (s_out_bit[6] << 4) + s_out_bit[7];
     s_out_bit(0) = s_out_bit(0) * (2 ^ 4) + s_out_bit(1)
     s_out_bit(1) = s_out_bit(2) * (2 ^ 4) + s_out_bit(3)
     s_out_bit(2) = s_out_bit(4) * (2 ^ 4) + s_out_bit(5)
     s_out_bit(3) = s_out_bit(6) * (2 ^ 4) + s_out_bit(7)
     
     '//转成二进制字符串处理
     ASCII2Bin s_out_bit(), s_byte()
     
     '//换位
     'for(i = 0; i < 32; i++)
     ' s_byte1[i] = s_byte[p[i] - 1];
     For i = 0 To 31
     s_byte1(i) = s_byte(P(i) - 1)
     Next
     
     '//生成最后结果
     Bin2ASCII s_byte1(), s_bit()
     
    End Sub
     
     
     
     
     
    Private Sub Class_Initialize()
     Dim i As Integer, j As Integer, k As Integer, L As Integer
     Dim aT, S As String
     '//换位表IP
     S = "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"
     aT = Split(S, ",")
     For i = 0 To 63: IP(i) = Val(aT(i)): Next
     
     '//换位表IP_1
     S = "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"
     aT = Split(S, ",")
     For i = 0 To 63: IP_1(i) = Val(aT(i)): Next
     
     '//放大换位表
     S = "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"
     aT = Split(S, ",")
     For i = 0 To 47: E(i) = Val(aT(i)): Next
     
     
     '缩小换位表1
     S = "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"
     aT = Split(S, ",")
     For i = 0 To 55: PC_1(i) = Val(aT(i)): Next
     
     
     '//缩小换位表2
     S = "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"
     aT = Split(S, ",")
     For i = 0 To 47: PC_2(i) = Val(aT(i)): Next
     
     '//16次循环左移对应的左移位数
     S = "1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1"
     aT = Split(S, ",")
     For i = 0 To 15: ccmovebit(i) = Val(aT(i)): Next
     
     
     S = "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"
     aT = Split(S, ",")
     For i = 0 To 31
     P(i) = Val(aT(i))
     Next
     
     S = "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," & _
     "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," & _
     "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," & _
     "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,"
     
     S = S & _
     "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," & _
     "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," & _
     "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," & _
     "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"
     aT = Split(S, ",")
     L = 0
     For i = 0 To 7
     For j = 0 To 3
     For k = 0 To 15
     ss(i, j, k) = Val(aT(L))
     L = L + 1
     Next
     Next
     Next
     
    End Sub
'---------------实际调用代码-----------------
Dim oDes As New DES3Private Sub Command1_Click()
        'des加密        Dim oDes     As New DES3
        
        Dim M()     As Byte, E()       As Byte
        
        M = StrConv(Text1, vbFromUnicode)
        
        oDes.EncryptDes_ArrToArr M, E, "1"
        
        Open "c:\des.txt " For Binary As #1
        Put #1, , E
        Close #1
        
      
End Sub
Private Sub Command2_Click()
        'des解密        Dim S()     As Byte, M()       As Byte
              
        Open "c:\des.txt " For Binary As #1
        
        ReDim S(LOF(1) - 1)
        
        Get #1, , S
        
        Close #1        Dim oDes     As New DES3
        oDes.EncryptDes_ArrToArr S, M, "1", 2        Dim str1     As String
        str1 = StrConv(M, vbUnicode)        Text3 = str1
End Sub