100分求 DES加密/解密 算法的函数或Dll，能在VB中的实现!

Question

今天在网上搜索了一个下午,没找到理想的.向各位XDJM求一个 现成的,稳定的 DES加密/解密算法的函数或Dll都可以. 先谢了!

Answer 1

search "Large Archive of Cryptographic Algorithms"A Source Code at:http://www.freevbcode.com/ShowCode.Asp?ID=3779没有测试。

Answer 2

http://topic.csdn.net/t/20050706/12/4126283.html

Answer 3

例子:http://www.m5home.com/bbs/dispbbs.asp?boardID=2&ID=1445&page=2类模块:http://www.m5home.com/bbs/dispbbs.asp?boardID=10&ID=1448&page=1

Answer 4

to VBAdvisor(Sunlight) 
   下载那网址的代码,但调试通过不了to CathySun118(斯年)
   你提供的地址,之前已经看过.里面提供的代码不完整to myjian
   那个cDES.cls例子,整不明白.
   下载了那个 下载DES Library  也是让人扫兴这个 des  算法还真难找啊...

Answer 5

这种东西遍地都是。我曾下载了 DES C 代码实现，用它做过一个 DLL。后来又下载了一个类模块，改改代码，将对 ASCII 码加密改为对 Hex 串加密，也很好用。其实自己写一个也不难。

Answer 6

'************************************************************************
    '*
    '*
    '* 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
     ReDim Preserve Key(7) As Byte
     GenSubKey Key(), key_n1()
    End Sub
     
     
     

Answer 7

'=========================================================================================
    ' SetKey2 函数说明：
    ' 设置3DES加/解密的的第二个密钥
    ' 返回：
    ' 无
    ' 参数：
    ' K_Bit() AS Byte 密钥,不少于8个元素
    '==========================================================================================
    Sub SetKey2(K_Bit() As Byte)
     '//根据密钥生成16个子密钥
     Dim Key() As Byte
     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
     
     
     
    '==========================================================================================
    ' 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 8

'/*
    ' * 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
     
     
     
     
    '/*
    ' * 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
     
     

Answer 9

     
     
    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

Answer 10

将上面的内存粘贴到一个类文件中，取类名为 CDes然后使用下面的代码测试：Sub test()
    'des加密    Dim oDes As New CDes
    
    Dim m() As Byte, e() As Byte
    
    m = StrConv("测试DES加密", vbFromUnicode)
    
    oDes.EncryptDes_ArrToArr m, e, "123"
    
    Open "c:\des.txt" For Binary As #1
    Put #1, , e
    Close #1
    
   
End SubSub test2()
    '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 CDes
    oDes.EncryptDes_ArrToArr s, m, "123"    Dim str1 As String
    str1 = StrConv(m, vbUnicode)    Debug.Print str1
End Sub运行 test 过程后，生成的 c:\des.txt 的内容是被加密码过的，你看不到明文；test2 过程读取这个文件，解密码后会输出加密码前的内容："测试DES加密" 

Answer 11

test2() 中的有一句要改一下：oDes.EncryptDes_ArrToArr s, m, "123",2作者的代码中说第4个参数为2时是解密！！
不过我测试时没有给参数，也一样解密成功。:-P

Answer 12

to myjian
   那个cDES.cls例子,整不明白.
   下载了那个 下载DES Library  也是让人扫兴
//无语了...第一个地址里我最后不是写了一个例子吗.....闪人.......

Answer 13

感谢fxy_2002(阿勇) 提供的源代码。我已测试通过。
但阿勇tx的使用有错误， 
cdes类在加解密前要调用setkey函数设置密码。
    SetKey mm
    
    Encrypt3Des_ArrToArr m_bit, e_bit, bFlag

Answer 14

直接使用微软的加解密API，声明如下：
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hSessionKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef hSessionKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hSessionKey As Long) As Long
Private Declare Function CryptImportKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal hPubKey As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Private Declare Function CryptExportKey Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hExpKey As Long, ByVal dwBlobType As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByVal pbBuffer As String) As Long
该套API支持DES，LZ可以随便写一个上述API名称再加上DES关键GOOGLE一下即可，虽然大多是VC的，但不难改成VB版。