精华内容
下载资源
问答
  • vb 加密代码 VB加密算法DES程序源代码收藏
  • VB加密算法DES程序源代码

    千次阅读 热门讨论 2005-10-04 10:58:00
    ' bFlag As Byte 可选输入,为2则解密,其它或为缺省时为加密   '==========================================================================================   Sub Encrypt3Des_ArrToArr(m_bit() As Byte...
    '************************************************************************ 
        '*
        '*
        '* 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
        
        
        
        '=========================================================================================
        ' 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
        
        
        '/*
        ' * 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
        
        
        
        
        
        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

    展开全文
  • VB加密算法代码集锦.rar

    热门讨论 2011-12-12 15:13:10
    这个加解密源码几乎包括了世界上几个最著名的加密算法:Blowfish、CryptAPI、DES、Gost、RC4、XOR、Skipjack、TEA、Twofish,曾获源码5星推荐 Business-strengthCompression.zip: 商用压缩+加密程序 ...
  • VB加密解密算法

    2012-06-03 09:32:16
    VB加密解密算法,VB编程原码,用于用户制作程序加密内容
  • 摘要:VB源码,加密解密,AES,字符串... AES加密算法VB源码演示程序,涉及加密算法以及文件加密、解密,在多种场合中都可应用,本加密程序可以加密字符和加密文件,当然也可解密,对学习AES算法当然是挺有参考意义的。
  • 在使用VB6.0软件编程过程中,收集了各种VB源码实例进行测试,然后按照自己的需要进行编辑整理。这里AES加密算法,适合新学者和初次编程人员进行参考。
  • VB实现对字符或者文件的AES加密VB6.0测试通过,很好的学习资料 VB实现对字符或者文件的AES加密VB6.0测试通过,很好的学习资料
  • rsa加密算法vb代码,包括两个素数的选取,含运行结果。
  • vb 编写 凯撒算法 加密解密程序 (可以加密文件) 适用 windows xp 不适用windows 7 老版本有错误 上传了新版本
  • vb 编写 凯撒算法 加密解密程序 (可以加密文件) (新) 附源代码 及一些说明.源程序没有传上来.搞丢
  • VB MD5 加密算法模块

    2008-10-01 01:33:27
    加密算法模块, 直接导入程序调用就可以了,意思一下就一分.
  • 加密算法 DESvb源程序

    2009-03-16 11:37:46
    DESvb源程序vb写的加密算法,相信对你有帮助
  • VB.NET实现RSA加密算法,源代码

    热门讨论 2011-05-20 14:05:29
    VB.NET实现的RSA加密算法,全部程序提供,VS2005环境下运行有效。生成有.exe格式
  • 对文件文件加密、解密等操作,程序整合了多种常用算法
  • VB MD5加密程序源码.rar

    2019-07-10 11:14:16
    VB MD5加密程序源码,MD5加密算法估计是最常用、简单的一种加密算法了,这个例子可以很好的演示如何在VB中实现MD5加密,你也可以把本程序当作一个加密小工具,放在手边,随时进行各种字符的MD5加密功能。
  • VB的算法源码集合(共33个)解压密码是: lob.cn ...VB下实现MD5加密算法源码 财务中将数字转换成中文大写 带输入功能的手写文字识别程序 顶级AES加密类模块 高级指纹分算法析源代码 最长公共子序列 。。。。
  • 程序是在VB6.0的基础上开发的,支持数据的加密和解密,还有可以对文件进行加密和解密。用户可以根据自己的密钥进行个性化的加密和解密。
  • 应用程序连接远程oracle数据库时,从配置文件.INI中读取用户名及密码,对于密码的加密与解密,采用DES加密算法。 database.ini文件格式 [database] username=ua password=CBF1DE02851D0E333F1F47B90C9A2442
  • 采用DES对文件进行加密,笨程序编写使用vb,DES算法提取为单独模块
  • vb.net实现des加密解密算法,winform程序,基于.net framework 2.0开发
  • 现暂时给出在VB、VC、Delphi三种开发语言中的调用方法,其他语言的调用方法可与我们联系获得,具体可以参看例子程序;现更新DLL可能被破解者替换的漏洞,并对DLL进行了加壳,增加了CRC校验功能,For Delphi还增加了...
  • 自定义VB程序加密方案

    千次阅读 2018-09-06 12:12:29
    目录 第一步,获取电脑唯一性标志 第二步,编密文 第三步,封装Dll 第四步,编客户端和注册机 ... 想到的就这些了,本案列以C盘序列号和电脑名为电脑的识别依据,以阐述加密算法  获取C...

    目录

    第一步,获取电脑唯一性标志

    第二步,编密文

    第三步,封装Dll

    第四步,编客户端和注册机

    注册

    C盘序列号

    电脑名

    第五步,应用程序引用


     


    第一步,获取电脑标志

        每一台电脑的标志有哪些?

        1、硬盘序列号

        2、电脑名

        3、IP地址

        想到的就这些了,本案列以C盘序列号和电脑名为电脑的识别依据,以阐述加密算法

        获取C盘序列号代码:

        Dim DriveID
        Set DriveID = CreateObject("Scripting.FileSystemObject")
        mySerial = DriveID.GetDrive("C").SerialNumber

        获取电脑名代码:

        dim PcName as string  '电脑名
        Set a = CreateObject("Wscript.Network")
        PcName =  a.ComputerName   

        OK,如果要给另一台电脑使用权限,限定识别时间,使用期限,加上试用次数
        差不多了。比如:

        信息大概这样写:2018/9/6_10_-2070513827_DESKTOP-NS7FOVN_2019/3/9

        解释下:日期(后续程序可以自定义保留5天)_试用次数_未注册或者注册信息错误但格式正确,提取该数字每次打开“-1”,      _C盘序列号_电脑名_到期日期(可设定为固定字段,然后封装到程序内,即便含义依然很难破解算法【dll封】)

    第二步,编密文

    第一步的注册信息基本完备,如上图,如果就这样给用户使用程序,注册码随便编一个也可,辛苦敲定的程序就成了做贡献了,别吃饭了,但是我们如何让用户看不懂注册码呢——加密算法。看看别个的算法介绍:

    https://blog.csdn.net/ddffr/article/details/77153127

    看了算法原理介绍以后(其实想多了),个人这几个渣渣小程序还没那么大的影响力,稍微秀一下小算法,简单点你破解依然很困难,除非你知道我的dll里面写的什么。来吧,我也来介绍下我的算法思路,算法相同,随便改改参数你都很难破解,而且为了这点成本花这么大力气破解这么简单的算法是没有必要的,我想。

    2018/9/6_10_-2070513827_DESKTOP-NS7FOVN_2019/3/9,将每一个字符转化为2个字符

    假定字符x,char(97)=a  ,  ASC(a)=97  , 则ASC(x)=yy 或则 ASC(x)=zzz

    大家知道,ascii码集中在33-126间,那么我减去某个数或则加上某个数那么这群数字就全是yy,或者zzz了

    我在逆向算法时按字段长度取出来就是了,正向算法时不足加上某个特定字符就可以了

    以下就是编译之后的注册码了,大哥们,谁有兴趣为小程序破译这个算法

    1、注册有时限

    2、试用有次数限制

    3、指定使用阶段,本参数在dll里面,怎么破

    4、限定使用时间

    5、针对你的C盘序列号和电脑名仅此一份

    本程序针对封闭式工程研发小程序,基本不予外网连接,困难点就是输入注册码较多,比较麻烦,但是实现原理简单

    不想麻烦那就用参考链接里面的大数因式分解吧,以后研究,我还没考虑好该如何将这几个信息变成大数呢,各位欢迎评论
     

    第三步,封装Dll

    继承第二部,我们需要将理论的算法付诸实践

    在该类模块插入以下代码,Change1是类Certif20的一个方法(正向编译成数字),其余程序就可以引用了——封装为dll。

    Public Function Change1(ByVal Str1 As String) As String
        Dim Str_B As String
        For i = 1 To Len(Str1)
            tt = Mid(Str1, i, 1)
            Str_B = Str_B & (Asc(tt) - 30)
        Next
        Change1 = Str_B
    End Function

    逆向编译段

    Public Function Change2(ByVal Str1 As String) As String
        Dim State01 As Boolean
        State01 = False
        For i = 1 To Len(Str1) / 2
            tt = Mid(Str1, i * 2 - 1, 2)
            Str_C = Str_C & Chr(CInt(tt) + 30)
        Next
        Change2 = Str_C
    End Function

    以上代码是两位的,如果要弄成3位的也可,参数做一下修改

    最后生成dll即可。

     

    第四步,编客户端和注册机

    图一图二分别是客户端和注册机界面,原理大家一看便知,便不多说了,直接上代码

    注册

    Private Sub Command1_Click()
        Rem 获取C盘序列号
        Dim C_str, CName, Str1 As String
        Dim DriveID
        Set DriveID = CreateObject("Scripting.FileSystemObject")
        C_str = DriveID.GetDrive("C").SerialNumber
        Set a = CreateObject("Wscript.Network")
        CName = a.ComputerName
        
        Dim Cer1 As
    Certif20
        Set Cer1 = New Certif20
        Str1 = Cer1.Change2(Text3.Text)
        Dim Arr1
        Arr1 = Split(Str1, "CQVB")
        If UBound(Arr1) <> 2 Then
            MsgBox "注册信息有误" & Chr(10) & "联系邮箱:510265404@qq.com", , "注册失败"
            Exit Sub
        End If
        If Arr1(1) <> CStr(C_str) Then
            MsgBox "序列号不匹配" & Chr(10) & "联系邮箱:510265404@qq.com", , "注册失败"
        ElseIf InStr(Arr1(2), CName) <> 1 Then
            MsgBox "电脑名不匹配" & Chr(10) & "联系邮箱:510265404@qq.com", , "注册失败"
        Else
            Dim date2 As Date
            date2 = right(Arr1(2), Len(Arr1(2)) - Len(CName))
            MsgBox "恭喜恭喜!" & Chr(10) & "有效期至: " & date2, , "注册成功"
            Rem 创建记录        *******************************************************
            Rem 判断有无缓存记录(txt),无则创建一个空值
            Dim fso As Object, blnExist As Boolean
            Set fso = CreateObject("Scripting.FileSystemObject")
            blnExist = fso.FileExists("D:\MSFus_1.0\Setting\Certif\licence.txt")
            If blnExist = False Then
            Dim sFile As Object
            Set sFile = fso.CreateTextFile("D:\MSFus_1.0\Setting\Certif\licence.txt", True)
            End If
            Rem 读取TXT
            Const ForWriting = 2
            Set sFile = fso.OpenTextFile("D:\MSFus_1.0\Setting\Certif\licence.txt", 2, TristateFalse)
            sFile.Write Text3.Text
            sFile.Close
            Set fso = Nothing
            Set sFile = Nothing
        End If
    End Sub

    C盘序列号

    Private Sub Command2_Click()
        Rem 获取C盘序列号
        Dim DriveID
        Set DriveID = CreateObject("Scripting.FileSystemObject")
        Text1.Text = DriveID.GetDrive("C").SerialNumber
    End Sub

    电脑名

    Private Sub Command3_Click()
        Set a = CreateObject("Wscript.Network")
        Text2.Text = a.ComputerName
    End Sub

    第五步,应用程序引用

    按上面描述的,实现以下几个功能

    1、注册有时限

    2、试用有次数限制

    3、指定使用阶段,本参数在dll里面

    4、限定使用时间

    5、针对你的C盘序列号和电脑名仅此一份

    列:2018/9/6_10_-2070513827_DESKTOP-NS7FOVN_2019/3/9

    1、逆向解析为上面信息串(使用dll的Change2)

    2、获取生成序列号的日期,与当前日期比较10天内可以注册,其余时间不予注册

    3、解析与本机不符的,但格式正确,将试用次数(-1),直至次数小于1程序提示不能使用,请注册

    4、注册成功的,试用次数直接至零,判断使用末期与注册日期是否符合指定阶段,不是不给运行

    5、判断当前日期是否比使用末期小,否则不予运行

    OK了,代码后续跟上……感谢各位支持。

     

     

    参考资源:

    https://blog.csdn.net/ddffr/article/details/77153127

    https://baike.baidu.com/item/DES/210508?fr=aladdin

    展开全文
  • VB的RC4加密算法,支持中文

    千次阅读 2008-07-13 02:22:00
    最近需要用VB写个小测试程序,所以把荒废了很久很久的vb翻了出来,从网上找了个10来兆的绿色版装上了。代码中测试中需要用到RC4的算法,于是从网上搜了一圈,结果很是失望,真正能用的几乎没有,网络上四处传播的那个...
        最近需要用VB写个小测试程序,所以把荒废了很久很久的vb翻了出来,从网上找了个10来兆的绿色版装上了。代码中测试中需要用到RC4的算法,于是从网上搜了一圈,结果很是失望,真正能用的几乎没有,网络上四处传播的那个代码,算法上应该说还是对的,但是采用String作为函数参数,结果处理的反而成错的了。这个错误的东西还四处传播,真是天下文章一大抄啊,居然这么多转贴的就没人做个简单的测试?      于是顺手按照c的代码,简单写了个程序,采用的是Byte数组来传递参数。调用的时候,可以采用strConv将普通的String和Byte数组做转换,或者省事就直接用String也是没问题的。
    
    
    
    Option Base 0
    
    
    
    Public Type rc4_key
    
        s(256) As Byte
    
        x As Byte
    
        y As Byte
    
    End Type
    
    
    
    Public Sub prepare_key(ByRef key_data() As Byte, ByRef key As rc4_key)
    
    
    
        Dim i As Long, j As Byte, keylen As Long, c As Integer
    
      
    
        For c = 0 To 255
    
            key.s(c) = c
    
        Next
    
      
    
        key.x = 0
    
        key.y = 0
    
        
    
        i = 0
    
        j = 0
    
        keylen = UBound(key_data) - LBound(key_data) + 1
    
        
    
        For c = 0 To 255
    
        
    
          j = ((key_data(i) Mod 256) + key.s(c) + j) Mod 256
    
          
    
          key.s(c) = key.s(c) Xor key.s(j)
    
          key.s(j) = key.s(c) Xor key.s(j)
    
          key.s(c) = key.s(c) Xor key.s(j)
    
          
    
          i = (i + 1) Mod keylen
    
        
    
        Next
    
        
    
    End Sub
    
    
    
    
    
    Public Sub rc4(ByRef buff() As Byte, ByRef key As rc4_key)
    
    
    
        Dim x As Byte, y As Byte, z As Byte, c As Long, ub As Long, lb As Long
    
      
    
    
    
        x = key.x
    
        y = key.y
    
        ub = UBound(buff)
    
        lb = LBound(buff)
    
    
    
        For c = lb To ub
    
            
    
            x = (x + 1) Mod 256
    
            y = ((key.s(x) Mod 256) + y) Mod 256
    
            
    
            key.s(x) = key.s(x) Xor key.s(y)
    
            key.s(y) = key.s(x) Xor key.s(y)
    
            key.s(x) = key.s(x) Xor key.s(y)
    
    
    
            z = ((key.s(x) Mod 256) + key.s(y)) Mod 256
    
            buff(c) = buff(c) Xor key.s(z)
    
            
    
        Next
    
        
    
        key.x = x
    
        key.y = y
    
    
    
    End Sub
    
    
    
    
     调用的方法     Dim s() As Byte, p() As Byte     Dim enkey As rc4_key, denkey As rc4_key         s = "1234567890abcdefghijklmnopqrstuvwxyz中文"     p = "123abc测试"         Call prepare_key(p, enkey)     denkey = enkey         Call rc4(s, enkey)     Call rc4(s, denkey)     MsgBox s 如果是多个内容加密,也可以分段解密,或者一次解密全部内容     Dim s() As Byte, p() As Byte     Dim enkey As rc4_key, denkey As rc4_key         s = "1234567890abcdefghijklmnopqrstuvwxyz中文"     p = "123abc测试"         Call prepare_key(p, enkey)     denkey = enkey         Call rc4(s, enkey)     Dim s2() As Byte, s3() As Byte         s2 = "信息abcd1234"     Call rc4(s2, enkey)         ReDim s3(0 To UBound(s) + UBound(s2) + 1)     Call CopyMemory(s3(0), s(0), UBound(s) + 1)     Call CopyMemory(s3(UBound(s) + 1), s2(0), UBound(s2) + 1)     Call rc4(s3, denkey)     MsgBox s3
    展开全文
  • 收集一些运行于VB环境的Blowfish Gost RC4等加密解密算法示例,都是一些比较常用且经典的VB6加密解密算法示例,同时适用于VB.NET编程,一共有将近10种的算法集中到了一个程序中演示,你在加密测试的时候可以选择任一...
  • 这两天要做个VB程序访问PHP的Web服务,传输内容用DES加密算法加密。做的时候发现VB.net带的DES加密算法和我PHP里的不一样,PHP已经是成型产品,不能修改,于是就把PHP里的加密算法翻译了一遍。一天一夜,真不容易。...
  • 这个程序加密原理很简单,就是先将一段文字用base64编码,然后再用凯撒编码,再输出。 压缩包内文件夹: zh-cn:中文的程序和源码 lib:程序类库和源码,关于怎么用这个库就看代码就行了 Wizard:没做完,是个...
  • QQ2013解析最新QQ加密算法VB登陆方法

    千次阅读 2013-10-14 10:48:38
    今天开始想写个验证QQ密码的工具,以前写过一个QQ验证器的程序,就拿了那个代码试了一下居然不能同。就到QQ登陆页面去抓包。 xmit.jpg (110.62 KB, 下载次数: 111) 下载附件 保存到相册 2013-3
     
    

    http://xmit.org.cn/forum.php?mod=viewthread&tid=3409&extra=page=1&page=1&


    今天开始想写个验证QQ密码的工具,以前写过一个QQ验证器的程序,就拿了那个代码试了一下居然不能同。就到QQ登陆页面去抓包。

    xmit.jpg (110.62 KB, 下载次数: 111)

    下载附件  保存到相册

    2013-3-19 23:18 上传


    上图是抓包的数据

    然后在登录页面找js加密代码。comm.js

    1. var hexcase = 1;
    2. var b64pad = "";
    3. var chrsz = 8;
    4. var mode = 32;
    5. function md5(A) {
    6.         return hex_md5(A)
    7. }
    8. function hex_md5(A) {
    9.         return binl2hex(core_md5(str2binl(A), A.length * chrsz))
    10. }
    11. function str_md5(A) {
    12.         return binl2str(core_md5(str2binl(A), A.length * chrsz))
    13. }
    14. function hex_hmac_md5(A, B) {
    15.         return binl2hex(core_hmac_md5(A, B))
    16. }
    17. function b64_hmac_md5(A, B) {
    18.         return binl2b64(core_hmac_md5(A, B))
    19. }
    20. function str_hmac_md5(A, B) {
    21.         return binl2str(core_hmac_md5(A, B))
    22. }
    23. function core_md5(K, F) {
    24.         K[F >> 5] |= 128 << ((F) % 32);
    25.         K[(((F + 64) >>> 9) << 4) + 14] = F;
    26.         var J = 1732584193;
    27.         var I = -271733879;
    28.         var H = -1732584194;
    29.         var G = 271733878;
    30.         for (var C = 0; C < K.length; C += 16) {
    31.                 var E = J;
    32.                 var D = I;
    33.                 var B = H;
    34.                 var A = G;
    35.                 J = md5_ff(J, I, H, G, K[C + 0], 7, -680876936);
    36.                 G = md5_ff(G, J, I, H, K[C + 1], 12, -389564586);
    37.                 H = md5_ff(H, G, J, I, K[C + 2], 17, 606105819);
    38.                 I = md5_ff(I, H, G, J, K[C + 3], 22, -1044525330);
    39.                 J = md5_ff(J, I, H, G, K[C + 4], 7, -176418897);
    40.                 G = md5_ff(G, J, I, H, K[C + 5], 12, 1200080426);
    41.                 H = md5_ff(H, G, J, I, K[C + 6], 17, -1473231341);
    42.                 I = md5_ff(I, H, G, J, K[C + 7], 22, -45705983);
    43.                 J = md5_ff(J, I, H, G, K[C + 8], 7, 1770035416);
    44.                 G = md5_ff(G, J, I, H, K[C + 9], 12, -1958414417);
    45.                 H = md5_ff(H, G, J, I, K[C + 10], 17, -42063);
    46.                 I = md5_ff(I, H, G, J, K[C + 11], 22, -1990404162);
    47.                 J = md5_ff(J, I, H, G, K[C + 12], 7, 1804603682);
    48.                 G = md5_ff(G, J, I, H, K[C + 13], 12, -40341101);
    49.                 H = md5_ff(H, G, J, I, K[C + 14], 17, -1502002290);
    50.                 I = md5_ff(I, H, G, J, K[C + 15], 22, 1236535329);
    51.                 J = md5_gg(J, I, H, G, K[C + 1], 5, -165796510);
    52.                 G = md5_gg(G, J, I, H, K[C + 6], 9, -1069501632);
    53.                 H = md5_gg(H, G, J, I, K[C + 11], 14, 643717713);
    54.                 I = md5_gg(I, H, G, J, K[C + 0], 20, -373897302);
    55.                 J = md5_gg(J, I, H, G, K[C + 5], 5, -701558691);
    56.                 G = md5_gg(G, J, I, H, K[C + 10], 9, 38016083);
    57.                 H = md5_gg(H, G, J, I, K[C + 15], 14, -660478335);
    58.                 I = md5_gg(I, H, G, J, K[C + 4], 20, -405537848);
    59.                 J = md5_gg(J, I, H, G, K[C + 9], 5, 568446438);
    60.                 G = md5_gg(G, J, I, H, K[C + 14], 9, -1019803690);
    61.                 H = md5_gg(H, G, J, I, K[C + 3], 14, -187363961);
    62.                 I = md5_gg(I, H, G, J, K[C + 8], 20, 1163531501);
    63.                 J = md5_gg(J, I, H, G, K[C + 13], 5, -1444681467);
    64.                 G = md5_gg(G, J, I, H, K[C + 2], 9, -51403784);
    65.                 H = md5_gg(H, G, J, I, K[C + 7], 14, 1735328473);
    66.                 I = md5_gg(I, H, G, J, K[C + 12], 20, -1926607734);
    67.                 J = md5_hh(J, I, H, G, K[C + 5], 4, -378558);
    68.                 G = md5_hh(G, J, I, H, K[C + 8], 11, -2022574463);
    69.                 H = md5_hh(H, G, J, I, K[C + 11], 16, 1839030562);
    70.                 I = md5_hh(I, H, G, J, K[C + 14], 23, -35309556);
    71.                 J = md5_hh(J, I, H, G, K[C + 1], 4, -1530992060);
    72.                 G = md5_hh(G, J, I, H, K[C + 4], 11, 1272893353);
    73.                 H = md5_hh(H, G, J, I, K[C + 7], 16, -155497632);
    74.                 I = md5_hh(I, H, G, J, K[C + 10], 23, -1094730640);
    75.                 J = md5_hh(J, I, H, G, K[C + 13], 4, 681279174);
    76.                 G = md5_hh(G, J, I, H, K[C + 0], 11, -358537222);
    77.                 H = md5_hh(H, G, J, I, K[C + 3], 16, -722521979);
    78.                 I = md5_hh(I, H, G, J, K[C + 6], 23, 76029189);
    79.                 J = md5_hh(J, I, H, G, K[C + 9], 4, -640364487);
    80.                 G = md5_hh(G, J, I, H, K[C + 12], 11, -421815835);
    81.                 H = md5_hh(H, G, J, I, K[C + 15], 16, 530742520);
    82.                 I = md5_hh(I, H, G, J, K[C + 2], 23, -995338651);
    83.                 J = md5_ii(J, I, H, G, K[C + 0], 6, -198630844);
    84.                 G = md5_ii(G, J, I, H, K[C + 7], 10, 1126891415);
    85.                 H = md5_ii(H, G, J, I, K[C + 14], 15, -1416354905);
    86.                 I = md5_ii(I, H, G, J, K[C + 5], 21, -57434055);
    87.                 J = md5_ii(J, I, H, G, K[C + 12], 6, 1700485571);
    88.                 G = md5_ii(G, J, I, H, K[C + 3], 10, -1894986606);
    89.                 H = md5_ii(H, G, J, I, K[C + 10], 15, -1051523);
    90.                 I = md5_ii(I, H, G, J, K[C + 1], 21, -2054922799);
    91.                 J = md5_ii(J, I, H, G, K[C + 8], 6, 1873313359);
    92.                 G = md5_ii(G, J, I, H, K[C + 15], 10, -30611744);
    93.                 H = md5_ii(H, G, J, I, K[C + 6], 15, -1560198380);
    94.                 I = md5_ii(I, H, G, J, K[C + 13], 21, 1309151649);
    95.                 J = md5_ii(J, I, H, G, K[C + 4], 6, -145523070);
    96.                 G = md5_ii(G, J, I, H, K[C + 11], 10, -1120210379);
    97.                 H = md5_ii(H, G, J, I, K[C + 2], 15, 718787259);
    98.                 I = md5_ii(I, H, G, J, K[C + 9], 21, -343485551);
    99.                 J = safe_add(J, E);
    100.                 I = safe_add(I, D);
    101.                 H = safe_add(H, B);
    102.                 G = safe_add(G, A)
    103.         }
    104.         if (mode == 16) {
    105.                 return Array(I, H)
    106.         } else {
    107.                 return Array(J, I, H, G)
    108.         }
    109. }
    110. function md5_cmn(F, C, B, A, E, D) {
    111.         return safe_add(bit_rol(safe_add(safe_add(C, F), safe_add(A, D)), E), B)
    112. }
    113. function md5_ff(C, B, G, F, A, E, D) {
    114.         return md5_cmn((B & G) | ((~B) & F), C, B, A, E, D)
    115. }
    116. function md5_gg(C, B, G, F, A, E, D) {
    117.         return md5_cmn((B & F) | (G & (~F)), C, B, A, E, D)
    118. }
    119. function md5_hh(C, B, G, F, A, E, D) {
    120.         return md5_cmn(B ^ G ^ F, C, B, A, E, D)
    121. }
    122. function md5_ii(C, B, G, F, A, E, D) {
    123.         return md5_cmn(G ^ (B | (~F)), C, B, A, E, D)
    124. }
    125. function core_hmac_md5(C, F) {
    126.         var E = str2binl(C);
    127.         if (E.length > 16) {
    128.                 E = core_md5(E, C.length * chrsz)
    129.         }
    130.         var A = Array(16),
    131.         D = Array(16);
    132.         for (var B = 0; B < 16; B++) {
    133.                 A[B] = E[B] ^ 909522486;
    134.                 D[B] = E[B] ^ 1549556828
    135.         }
    136.         var G = core_md5(A.concat(str2binl(F)), 512 + F.length * chrsz);
    137.         return core_md5(D.concat(G), 512 + 128)
    138. }
    139. function safe_add(A, D) {
    140.         var C = (A & 65535) + (D & 65535);
    141.         var B = (A >> 16) + (D >> 16) + (C >> 16);
    142.         return (B << 16) | (C & 65535)
    143. }
    144. function bit_rol(A, B) {
    145.         return (A << B) | (A >>> (32 - B))
    146. }
    147. function str2binl(D) {
    148.         var C = Array();
    149.         var A = (1 << chrsz) - 1;
    150.         for (var B = 0; B < D.length * chrsz; B += chrsz) {
    151.                 C[B >> 5] |= (D.charCodeAt(B / chrsz) & A) << (B % 32)
    152.         }
    153.         return C
    154. }
    155. function binl2str(C) {
    156.         var D = "";
    157.         var A = (1 << chrsz) - 1;
    158.         for (var B = 0; B < C.length * 32; B += chrsz) {
    159.                 D += String.fromCharCode((C[B >> 5] >>> (B % 32)) & A)
    160.         }
    161.         return D
    162. }
    163. function binl2hex(C) {
    164.         var B = hexcase ? "0123456789ABCDEF": "0123456789abcdef";
    165.         var D = "";
    166.         for (var A = 0; A < C.length * 4; A++) {
    167.                 D += B.charAt((C[A >> 2] >> ((A % 4) * 8 + 4)) & 15) + B.charAt((C[A >> 2] >> ((A % 4) * 8)) & 15)
    168.         }
    169.         return D
    170. }
    171. function binl2b64(D) {
    172.         var C = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
    173.         var F = "";
    174.         for (var B = 0; B < D.length * 4; B += 3) {
    175.                 var E = (((D[B >> 2] >> 8 * (B % 4)) & 255) << 16) | (((D[B + 1 >> 2] >> 8 * ((B + 1) % 4)) & 255) << 8) | ((D[B + 2 >> 2] >> 8 * ((B + 2) % 4)) & 255);
    176.                 for (var A = 0; A < 4; A++) {
    177.                         if (B * 8 + A * 6 > D.length * 32) {
    178.                                 F += b64pad
    179.                         } else {
    180.                                 F += C.charAt((E >> 6 * (3 - A)) & 63)
    181.                         }
    182.                 }
    183.         }
    184.         return F
    185. }
    186. function hexchar2bin(str) {
    187.         var arr = [];
    188.         for (var i = 0; i < str.length; i = i + 2) {
    189.                 arr.push("\\x" + str.substr(i, 2))
    190.         }
    191.         arr = arr.join("");
    192.         eval("var temp = '" + arr + "'");
    193.         return temp
    194. }
    复制代码
    说下QQ密码加密的过程
    MD5( MD5(HexChar2Bin(MD5(密码))& pt_uin) & 转换大写(验证码))

    pt_uin就是在获取验证码过程会出现的。也就是图片上的那个
    1. ptui_checkVC('0','!VFZ','这里的值就是pt_uin');
    复制代码
    HexChar2Bin在js的代码如下
    代码意思是 把加密好的md5解析成\X形式
    例如md5是000000003CCB4845 每个两位就加\X
    \x00\x00\x00\x00\x3c\xcb\x48\x45
    1. function hexchar2bin(str) {
    2.         var arr = [];
    3.         for (var i = 0; i < str.length; i = i + 2) {
    4.                 arr.push("\\x" + str.substr(i, 2))
    5.         }
    6.         arr = arr.join("");
    7.         eval("var temp = '" + arr + "'");
    8.         return temp
    9. }
    复制代码
    最后是VB代码写法 QQ624475210
    -----------完美分割-------------------------------------
    获取验证码数据包
    1. GET /check?uin=624475210&appid=2001601&js_ver=10024&js_type=0&login_sig=w7Qp74zpqu9F54TvPTxIT-QD*GJDtnYyPomst4qzu*Hj6jtyrG5Tn-9j28X**F5h&u1=http%3A%2F%2Faq.qq.com%2Fcn2%2Findex&r=0.3231462363368756 HTTP/1.1
    2. Accept: */*
    3. Referer: https://ui.ptlogin2.qq.com/cgi-bin/login?appid=2001601&no_verifyimg=1&f_url=loginerroralert&lang=0&target=top&hide_title_bar=1&s_url=http%3A//aq.qq.com/cn2/index&qlogin_jumpname=aqjump&qlogin_param=aqdest%3Dhttp%253A//aq.qq.com/cn2/index&css=https%3A//aq.qq.com/v2/css/login.css
    4. Accept-Language: zh-cn
    5. Accept-Encoding: gzip, deflate
    6. User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)
    7. Host: ssl.ptlogin2.qq.com
    8. Connection: Keep-Alive
    9. Cookie: ptisp=ctc; pgv_pvi=2165683210; pgv_pvid=9443471012; pt2gguin=o624475210; RK=TjbXU61q/f; ptui_loginuin=1255240802; o_cookie=624475210; verifysession=h00ba1daa53a6b6d33c754afc343db2340a5efdf79b81c20ef508edcd26c4c980867db892c5ca0f9f545a1f4584725e05c9; ptcz=e5f1078720f1aecb439f759fa9d77943198a7aa8d4888e2c72970f6d291a7749; uikey=c61a0233c14f20eceb6a3fcd476d6ae326f4e15deada6975e10a9a50ca1d39f5; chkuin=624475210; confirmuin=1255240802; ptvfsession=bb5e93319ac81ea3550dac9ffb00f8540288c4e5649cebfedfe999683019ba9ae483104b8ea8845d338703f7b1aeeef6; ETK=Moqjel9E9*X*cSwGgRawqrIb-kQOJX05qOOn11cZiVIbZ9PHqiztXxnQZu-onB7S0mDgHmKTvfJGuFpg3DC0Cg__
    复制代码
    返回数据
    3c
    ptui_checkVC('0','!VFZ','\x00\x00\x00\x00\x26\x8c\xd0\x10');
    0

    GET登陆QQ数据包
    1. GET /login?u=624475210&p=49E3214E176FCA73F2CEE205BE109E2F&verifycode=!VEZ&aid=2001601&u1=http%3A%2F%2Faq.qq.com%2Fcn2%2Findex&h=1&ptredirect=1&ptlang=2052&from_ui=1&dumy=&fp=loginerroralert&action=3-6-9687&mibao_css=&t=1&g=1&js_type=0&js_ver=10024&login_sig=w7Qp74zpqu9F54TvPTxIT-QD*GJDtnYyPomst4qzu*Hj6jtyrG5Tn-9j28X**F5h HTTP/1.1
    2. Accept: */*
    3. Referer: https://ui.ptlogin2.qq.com/cgi-bin/login?appid=2001601&no_verifyimg=1&f_url=loginerroralert&lang=0&target=top&hide_title_bar=1&s_url=http%3A//aq.qq.com/cn2/index&qlogin_jumpname=aqjump&qlogin_param=aqdest%3Dhttp%253A//aq.qq.com/cn2/index&css=https%3A//aq.qq.com/v2/css/login.css
    4. Accept-Language: zh-cn
    5. Accept-Encoding: gzip, deflate
    6. User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)
    7. Host: ssl.ptlogin2.qq.com
    8. Connection: Keep-Alive
    9. Cookie: ptisp=ctc; pgv_pvi=2135683200; pgv_pvid=9243471012; pt2gguin=o624475210; RK=TjbXU61q/f; ptui_loginuin=1255240802; o_cookie=624475210; verifysession=h00ba1daa53a6b6d33c754afc343db2340a5efef79b81c20ef508edcd26c4c980867db892c5ca0f9f545a1f4584725e05c9; ptcz=e5f1078720f1aecb439f759fa9d77943198a7aa8d4888e2c72970f6d291a7749; uikey=c61a0233c1df20eceb6a3fcd476d6ae326f4e15eeada6975e10a9a50ca1d39f5; chkuin=624475210; confirmuin=624475210; ptvfsession=d53eef18c6512eb9bbab032174f38f49175d8df386abbbc9eb06d0b58e8b3b66978c323b61710858510ac7abff008566; ETK=Moqjel9E9*X*cSwGgRawqrIb-kQOJX05qOOn11cZiVIbZ9PHqiztXxnQZu-onB7S0mDgHmKTvfJGuFpg3DC0Cg__
    复制代码
    登陆返回数据包

    58
    ptuiCB('0','0','http://web.qq.com/loginproxy.html?login2qq=1&webqq_type=10','0','登录成功!','dzzzzzzzz');

    0

    QQ登陆错误数据包
    ptuiCB('7','0','','0','很遗憾,网络连接出现异常,请您稍后再试。(2772435371)', '624475210');
    ptuiCB('3','0','','0','您输入的帐号或密码不正确,请重新输入。', '624475210');
    ptuiCB('4','3','','0','登录失败,请重试。*', '624475210');

    ----------------------------------------------------------------------------------------------
    展开全文
  • TEA 算法加密解密模块,可用于程序注册保护等方面,vb源码

空空如也

空空如也

1 2 3 4 5 ... 8
收藏数 147
精华内容 58
关键字:

vb加密算法程序