精华内容
下载资源
问答
  • EXCEL vba实现md5加密

    2018-04-04 09:24:52
    使用之前要启用宏。excel文件点击 文件->选项->信任中心->信任中心设置->宏设置→启用所有宏。 注意:经过测试Win10系统无法运行
  • VBA实现MD5加密

    2021-01-06 20:54:04
    F(x, y, z) md5_F = (x And y) Or ((Not x) And z) End Function Private Function md5_G(x, y, z) md5_G = (x And z) Or (y And (Not z)) End Function Private Function md5_H(x, y, z) md5_H = (x Xor y Xor z) ...
    Private Const BITS_TO_A_BYTE = 8
    Private Const BYTES_TO_A_WORD = 4
    Private Const BITS_TO_A_WORD = 32
    
    Private m_lOnBits(30)
    Private m_l2Power(30)
    
    Private Function LShift(lValue, iShiftBits)
        If iShiftBits = 0 Then
            LShift = lValue
            Exit Function
        ElseIf iShiftBits = 31 Then
            If lValue And 1 Then
                LShift = &H80000000
            Else
                LShift = 0
            End If
            Exit Function
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
            Err.Raise 6
        End If
        
        If (lValue And m_l2Power(31 - iShiftBits)) Then
            LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
        Else
            LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
        End If
    End Function
    
    Private Function RShift(lValue, iShiftBits)
        If iShiftBits = 0 Then
            RShift = lValue
            Exit Function
        ElseIf iShiftBits = 31 Then
            If lValue And &H80000000 Then
                RShift = 1
            Else
                RShift = 0
            End If
            Exit Function
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
            Err.Raise 6
        End If
        
        RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
        
        If (lValue And &H80000000) Then
            RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
        End If
    End Function
    
    Private Function RotateLeft(lValue, iShiftBits)
        RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
    End Function
    
    Private Function AddUnsigned(lX, lY)
        Dim lX4
        Dim lY4
        Dim lX8
        Dim lY8
        Dim lResult
        
        lX8 = lX And &H80000000
        lY8 = lY And &H80000000
        lX4 = lX And &H40000000
        lY4 = lY And &H40000000
        
        lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
        
        If lX4 And lY4 Then
            lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
        ElseIf lX4 Or lY4 Then
            If lResult And &H40000000 Then
                lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
            Else
                lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
            End If
        Else
            lResult = lResult Xor lX8 Xor lY8
        End If
        
        AddUnsigned = lResult
    End Function
    
    Private Function md5_F(x, y, z)
        md5_F = (x And y) Or ((Not x) And z)
    End Function
    
    Private Function md5_G(x, y, z)
        md5_G = (x And z) Or (y And (Not z))
    End Function
    
    Private Function md5_H(x, y, z)
        md5_H = (x Xor y Xor z)
    End Function
    
    Private Function md5_I(x, y, z)
        md5_I = (y Xor (x Or (Not z)))
    End Function
    
    Private Sub md5_FF(a, b, c, d, x, s, ac)
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
    End Sub
    
    Private Sub md5_GG(a, b, c, d, x, s, ac)
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
    End Sub
    
    Private Sub md5_HH(a, b, c, d, x, s, ac)
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
    End Sub
    
    Private Sub md5_II(a, b, c, d, x, s, ac)
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
    End Sub
    
    Private Function ConvertToWordArray(sMessage)
        Dim lMessageLength
        Dim lNumberOfWords
        Dim lWordArray()
        Dim lBytePosition
        Dim lByteCount
        Dim lWordCount
        
        Const MODULUS_BITS = 512
        Const CONGRUENT_BITS = 448
        
        lMessageLength = Len(sMessage)
        
        lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
        ReDim lWordArray(lNumberOfWords - 1)
        
        lBytePosition = 0
        lByteCount = 0
        Do Until lByteCount >= lMessageLength
            lWordCount = lByteCount \ BYTES_TO_A_WORD
            lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
            lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
            lByteCount = lByteCount + 1
        Loop
        
        lWordCount = lByteCount \ BYTES_TO_A_WORD
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
        
        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
        
        lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
        lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
        
        ConvertToWordArray = lWordArray
    End Function
    
    Private Function WordToHex(lValue)
        Dim lByte
        Dim lCount
        
        For lCount = 0 To 3
            lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
            WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
        Next
    End Function
    
    Public Function MD5(sMessage, stype)
        m_lOnBits(0) = CLng(1)
        m_lOnBits(1) = CLng(3)
        m_lOnBits(2) = CLng(7)
        m_lOnBits(3) = CLng(15)
        m_lOnBits(4) = CLng(31)
        m_lOnBits(5) = CLng(63)
        m_lOnBits(6) = CLng(127)
        m_lOnBits(7) = CLng(255)
        m_lOnBits(8) = CLng(511)
        m_lOnBits(9) = CLng(1023)
        m_lOnBits(10) = CLng(2047)
        m_lOnBits(11) = CLng(4095)
        m_lOnBits(12) = CLng(8191)
        m_lOnBits(13) = CLng(16383)
        m_lOnBits(14) = CLng(32767)
        m_lOnBits(15) = CLng(65535)
        m_lOnBits(16) = CLng(131071)
        m_lOnBits(17) = CLng(262143)
        m_lOnBits(18) = CLng(524287)
        m_lOnBits(19) = CLng(1048575)
        m_lOnBits(20) = CLng(2097151)
        m_lOnBits(21) = CLng(4194303)
        m_lOnBits(22) = CLng(8388607)
        m_lOnBits(23) = CLng(16777215)
        m_lOnBits(24) = CLng(33554431)
        m_lOnBits(25) = CLng(67108863)
        m_lOnBits(26) = CLng(134217727)
        m_lOnBits(27) = CLng(268435455)
        m_lOnBits(28) = CLng(536870911)
        m_lOnBits(29) = CLng(1073741823)
        m_lOnBits(30) = CLng(2147483647)
        
        m_l2Power(0) = CLng(1)
        m_l2Power(1) = CLng(2)
        m_l2Power(2) = CLng(4)
        m_l2Power(3) = CLng(8)
        m_l2Power(4) = CLng(16)
        m_l2Power(5) = CLng(32)
        m_l2Power(6) = CLng(64)
        m_l2Power(7) = CLng(128)
        m_l2Power(8) = CLng(256)
        m_l2Power(9) = CLng(512)
        m_l2Power(10) = CLng(1024)
        m_l2Power(11) = CLng(2048)
        m_l2Power(12) = CLng(4096)
        m_l2Power(13) = CLng(8192)
        m_l2Power(14) = CLng(16384)
        m_l2Power(15) = CLng(32768)
        m_l2Power(16) = CLng(65536)
        m_l2Power(17) = CLng(131072)
        m_l2Power(18) = CLng(262144)
        m_l2Power(19) = CLng(524288)
        m_l2Power(20) = CLng(1048576)
        m_l2Power(21) = CLng(2097152)
        m_l2Power(22) = CLng(4194304)
        m_l2Power(23) = CLng(8388608)
        m_l2Power(24) = CLng(16777216)
        m_l2Power(25) = CLng(33554432)
        m_l2Power(26) = CLng(67108864)
        m_l2Power(27) = CLng(134217728)
        m_l2Power(28) = CLng(268435456)
        m_l2Power(29) = CLng(536870912)
        m_l2Power(30) = CLng(1073741824)
        
        Dim x
        Dim k
        Dim AA
        Dim BB
        Dim CC
        Dim DD
        Dim a
        Dim b
        Dim c
        Dim d
        
        Const S11 = 7
        Const S12 = 12
        Const S13 = 17
        Const S14 = 22
        Const S21 = 5
        Const S22 = 9
        Const S23 = 14
        Const S24 = 20
        Const S31 = 4
        Const S32 = 11
        Const S33 = 16
        Const S34 = 23
        Const S41 = 6
        Const S42 = 10
        Const S43 = 15
        Const S44 = 21
        
        x = ConvertToWordArray(sMessage)
        
        a = &H67452301
        b = &HEFCDAB89
        c = &H98BADCFE
        d = &H10325476
        
        For k = 0 To UBound(x) Step 16
            AA = a
            BB = b
            CC = c
            DD = d
            
            md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
            md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
            md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
            md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
            md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
            md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
            md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
            md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
            md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
            md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
            md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
            md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
            md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
            md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
            md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
            md5_FF b, c, d, a, x(k + 15), S14, &H49B40821
            
            md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
            md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
            md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
            md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
            md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
            md5_GG d, a, b, c, x(k + 10), S22, &H2441453
            md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
            md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
            md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
            md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
            md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
            md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
            md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
            md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
            md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
            md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
            
            md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
            md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
            md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
            md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
            md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
            md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
            md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
            md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
            md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
            md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
            md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
            md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
            md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
            md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
            md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
            md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665
            
            md5_II a, b, c, d, x(k + 0), S41, &HF4292244
            md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
            md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
            md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
            md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
            md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
            md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
            md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
            md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
            md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
            md5_II c, d, a, b, x(k + 6), S43, &HA3014314
            md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
            md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
            md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
            md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
            md5_II b, c, d, a, x(k + 9), S44, &HEB86D391
            
            a = AddUnsigned(a, AA)
            b = AddUnsigned(b, BB)
            c = AddUnsigned(c, CC)
            d = AddUnsigned(d, DD)
        Next
        
        If stype = 32 Then
            MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
        Else
            MD5 = LCase(WordToHex(b) & WordToHex(c))
        End If
    End Function
    
    展开全文
  • VBA MD5加密算法实现

    2016-05-19 00:00:36
    VBA MD5加密 算法
  • 电子表格中调用MD5的方法 VBA 建议宏设置为低安全性

    使用效果如图:

    电子表格中调用方法1 如 某单元格中输入 =MD5(A1,16) 即可得到16位小写的标准md5值
    电子表格中调用方法2 如 某单元格中输入 =MD5(A1,32) 即可得到32位小写的标准md5值
    打开Excel按Alt+F11,然后点插入菜单中的模块,然后把这上面所有代码粘贴到模块1中,保存关闭即可在单元格中调用。

    以下是主要代码:

    Private Const BITS_TO_A_BYTE = 8
    Private Const BYTES_TO_A_WORD = 4
    Private Const BITS_TO_A_WORD = 32
    Private m_lOnBits(30)
    Private m_l2Power(30)
    
    Private Function LShift(lValue, iShiftBits)
    
        If iShiftBits = 0 Then
            LShift = lValue
            Exit Function
        ElseIf iShiftBits = 31 Then
            If lValue And 1 Then
                LShift = &H80000000
            Else
                LShift = 0
            End If
            Exit Function
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
            Err.Raise 6
        End If
        
        If (lValue And m_l2Power(31 - iShiftBits)) Then
            LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
        Else
            LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
        End If
        
    End Function
    
    Private Function RShift(lValue, iShiftBits)
    
        If iShiftBits = 0 Then
            RShift = lValue
            Exit Function
        ElseIf iShiftBits = 31 Then
            If lValue And &H80000000 Then
                RShift = 1
            Else
                RShift = 0
            End If
            Exit Function
        ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
            Err.Raise 6
        End If
        
        RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
        
        If (lValue And &H80000000) Then
            RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
        End If
        
    End Function
    
    Private Function RotateLeft(lValue, iShiftBits)
    
        RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
        
    End Function
    
    Private Function AddUnsigned(lX, lY)
    
        Dim lX4
        Dim lY4
        Dim lX8
        Dim lY8
        Dim lResult
        
        lX8 = lX And &H80000000
        lY8 = lY And &H80000000
        lX4 = lX And &H40000000
        lY4 = lY And &H40000000
        
        lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
        
        If lX4 And lY4 Then
            lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
        ElseIf lX4 Or lY4 Then
            If lResult And &H40000000 Then
                lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
            Else
                lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
            End If
        Else
            lResult = lResult Xor lX8 Xor lY8
        End If
        AddUnsigned = lResult
        
    End Function
    
    Private Function md5_F(x, y, z)
    
        md5_F = (x And y) Or ((Not x) And z)
        
    End Function
    
    Private Function md5_G(x, y, z)
    
        md5_G = (x And z) Or (y And (Not z))
        
    End Function
    
    Private Function md5_H(x, y, z)
    
        md5_H = (x Xor y Xor z)
        
    End Function
    
    Private Function md5_I(x, y, z)
    
        md5_I = (y Xor (x Or (Not z)))
        
    End Function
    
    Private Sub md5_FF(a, b, c, d, x, s, ac)
    
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
        
    End Sub
    
    Private Sub md5_GG(a, b, c, d, x, s, ac)
    
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
        
    End Sub
    
    Private Sub md5_HH(a, b, c, d, x, s, ac)
    
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
        
    End Sub
    
    Private Sub md5_II(a, b, c, d, x, s, ac)
    
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
        a = RotateLeft(a, s)
        a = AddUnsigned(a, b)
        
    End Sub
    
    Private Function ConvertToWordArray(sMessage)
    
        Dim lMessageLength
        Dim lNumberOfWords
        Dim lWordArray()
        Dim lBytePosition
        Dim lByteCount
        Dim lWordCount
        
        Const MODULUS_BITS = 512
        Const CONGRUENT_BITS = 448
        
        lMessageLength = Len(sMessage)
        
        lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
        ReDim lWordArray(lNumberOfWords - 1)
        
        lBytePosition = 0
        lByteCount = 0
        
        Do Until lByteCount >= lMessageLength
            lWordCount = lByteCount \ BYTES_TO_A_WORD
            lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
            lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
            lByteCount = lByteCount + 1
        Loop
        
        lWordCount = lByteCount \ BYTES_TO_A_WORD
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
        
        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
        
        lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
        lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
        
        ConvertToWordArray = lWordArray
        
    End Function
    
    Private Function WordToHex(lValue)
    
        Dim lByte
        Dim lCount
        
        For lCount = 0 To 3
            lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
            WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
        Next
        
    End Function
    
    Public Function MD5(sMessage, stype)
    
        m_lOnBits(0) = CLng(1)
        m_lOnBits(1) = CLng(3)
        m_lOnBits(2) = CLng(7)
        m_lOnBits(3) = CLng(15)
        m_lOnBits(4) = CLng(31)
        m_lOnBits(5) = CLng(63)
        m_lOnBits(6) = CLng(127)
        m_lOnBits(7) = CLng(255)
        m_lOnBits(8) = CLng(511)
        m_lOnBits(9) = CLng(1023)
        m_lOnBits(10) = CLng(2047)
        m_lOnBits(11) = CLng(4095)
        m_lOnBits(12) = CLng(8191)
        m_lOnBits(13) = CLng(16383)
        m_lOnBits(14) = CLng(32767)
        m_lOnBits(15) = CLng(65535)
        m_lOnBits(16) = CLng(131071)
        m_lOnBits(17) = CLng(262143)
        m_lOnBits(18) = CLng(524287)
        m_lOnBits(19) = CLng(1048575)
        m_lOnBits(20) = CLng(2097151)
        m_lOnBits(21) = CLng(4194303)
        m_lOnBits(22) = CLng(8388607)
        m_lOnBits(23) = CLng(16777215)
        m_lOnBits(24) = CLng(33554431)
        m_lOnBits(25) = CLng(67108863)
        m_lOnBits(26) = CLng(134217727)
        m_lOnBits(27) = CLng(268435455)
        m_lOnBits(28) = CLng(536870911)
        m_lOnBits(29) = CLng(1073741823)
        m_lOnBits(30) = CLng(2147483647)
        
        m_l2Power(0) = CLng(1)
        m_l2Power(1) = CLng(2)
        m_l2Power(2) = CLng(4)
        m_l2Power(3) = CLng(8)
        m_l2Power(4) = CLng(16)
        m_l2Power(5) = CLng(32)
        m_l2Power(6) = CLng(64)
        m_l2Power(7) = CLng(128)
        m_l2Power(8) = CLng(256)
        m_l2Power(9) = CLng(512)
        m_l2Power(10) = CLng(1024)
        m_l2Power(11) = CLng(2048)
        m_l2Power(12) = CLng(4096)
        m_l2Power(13) = CLng(8192)
        m_l2Power(14) = CLng(16384)
        m_l2Power(15) = CLng(32768)
        m_l2Power(16) = CLng(65536)
        m_l2Power(17) = CLng(131072)
        m_l2Power(18) = CLng(262144)
        m_l2Power(19) = CLng(524288)
        m_l2Power(20) = CLng(1048576)
        m_l2Power(21) = CLng(2097152)
        m_l2Power(22) = CLng(4194304)
        m_l2Power(23) = CLng(8388608)
        m_l2Power(24) = CLng(16777216)
        m_l2Power(25) = CLng(33554432)
        m_l2Power(26) = CLng(67108864)
        m_l2Power(27) = CLng(134217728)
        m_l2Power(28) = CLng(268435456)
        m_l2Power(29) = CLng(536870912)
        m_l2Power(30) = CLng(1073741824)
        
        
        Dim x
        Dim k
        Dim AA
        Dim BB
        Dim CC
        Dim DD
        Dim a
        Dim b
        Dim c
        Dim d
        
        Const S11 = 7
        Const S12 = 12
        Const S13 = 17
        Const S14 = 22
        Const S21 = 5
        Const S22 = 9
        Const S23 = 14
        Const S24 = 20
        Const S31 = 4
        Const S32 = 11
        Const S33 = 16
        Const S34 = 23
        Const S41 = 6
        Const S42 = 10
        Const S43 = 15
        Const S44 = 21
        
        x = ConvertToWordArray(sMessage)
        
        a = &H67452301
        b = &HEFCDAB89
        c = &H98BADCFE
        d = &H10325476
        
        For k = 0 To UBound(x) Step 16
            AA = a
            BB = b
            CC = c
            DD = d
            
            md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
            md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
            md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
            md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
            md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
            md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
            md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
            md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
            md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
            md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
            md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
            md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
            md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
            md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
            md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
            md5_FF b, c, d, a, x(k + 15), S14, &H49B40821
            
            md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
            md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
            md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
            md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
            md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
            md5_GG d, a, b, c, x(k + 10), S22, &H2441453
            md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
            md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
            md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
            md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
            md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
            md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
            md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
            md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
            md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
            md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
            
            md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
            md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
            md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
            md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
            md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
            md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
            md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
            md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
            md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
            md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
            md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
            md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
            md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
            md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
            md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
            md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665
            
            md5_II a, b, c, d, x(k + 0), S41, &HF4292244
            md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
            md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
            md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
            md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
            md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
            md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
            md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
            md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
            md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
            md5_II c, d, a, b, x(k + 6), S43, &HA3014314
            md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
            md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
            md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
            md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
            md5_II b, c, d, a, x(k + 9), S44, &HEB86D391
            
            a = AddUnsigned(a, AA)
            b = AddUnsigned(b, BB)
            c = AddUnsigned(c, CC)
            d = AddUnsigned(d, DD)
        Next
        
        If stype = 32 Then
            MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
        Else
            MD5 = LCase(WordToHex(b) & WordToHex(c))
        End If
        
    End Function

    以下是使用方法:


    电子表格中调用方法1如 =MD5(A1,16)
    电子表格中调用方法2如 =MD5(A1,32)
    打开Excel按Alt+F11,然后点插入菜单中的模块,然后把这上面所有代码粘贴到模块1中,保存关闭即可在单元格中调用。

    以下是代码插入方法:



    欢迎交流 ,冰冻木马, 电子邮箱 hcma#qq.com

    展开全文
  • Excel宏实现MD5加密

    2016-04-08 12:53:19
    在Excel中利用宏实现特定列数据进行MD5加密,支持16位和32位
  • MD5是一种不可逆的验证文件完整性的Message——Digest 算法,由MIT的实验室最早提出来,想了解历史的...具体的一个MD5的Excel VBA验证密码算法: Option Explicit Private Const OFFSET_4 = 4294967296# Private C

    MD5是一种不可逆的验证文件完整性的Message——Digest 算法,由MIT的实验室最早提出来,想了解历史的可以自行查阅,对于MD5不可逆的主要原因是Hash算法不可逆,其具体操作里的算法有求余Mod 操作,可以想象若都对数据对64求余,若余数为1,原始值可能为65,129……等无限多种可能,这也决定了MD5算法不可逆。

    具体的一个MD5的Excel VBA验证密码算法:

    Option Explicit
    Private Const OFFSET_4 = 4294967296#
    Private Const MAXINT_4 = 2147483647
    Private State(4) As Long
    Private ByteCounter As Long
    Private ByteBuffer(63) As Byte
    Private Const S11 = 7
    Private Const S12 = 12
    Private Const S13 = 17
    Private Const S14 = 22
    Private Const S21 = 5
    Private Const S22 = 9
    Private Const S23 = 14
    Private Const S24 = 20
    Private Const S31 = 4
    Private Const S32 = 11
    Private Const S33 = 16
    Private Const S34 = 23
    Private Const S41 = 6
    Private Const S42 = 10
    Private Const S43 = 15
    Private Const S44 = 21
    Public Function MD5_String(Expression As String) As String
    MD5Init
    MD5Update LenB(StrConv(Expression, vbFromUnicode)), StringToArray(Expression)
    MD5Final
    MD5_String = GetValues()
    End Function
    Public Function MD5_File(FileName As String) As String
    On Error GoTo ErrorHandler
    Dim FileO As Integer
    FileO = FreeFile
    Call FileLen(FileName)
    Open FileName For Binary Access Read As #FileO
    MD5Init
    Do While Not EOF(FileO)
    Get #FileO, , ByteBuffer
    If Loc(FileO) < LOF(FileO) Then
    ByteCounter = ByteCounter + 64
    MD5Transform ByteBuffer
    End If
    Loop
    ByteCounter = ByteCounter + (LOF(FileO) Mod 64)
    Close #FileO
    MD5Final
    MD5_File = GetValues
    ErrorHandler:
    Exit Function
    End Function
    Private Function StringToArray(InString As String) As Byte()
    Dim i As Integer, bytBuffer() As Byte
    ReDim bytBuffer(LenB(StrConv(InString, vbFromUnicode)))
    bytBuffer = StrConv(InString, vbFromUnicode)
    StringToArray = bytBuffer
    End Function
    Private Function GetValues() As String
    GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
    End Function
    Private Function LongToString(Num As Long) As String
    Dim a As Byte, b As Byte, c As Byte, d As Byte
    a = Num And &HFF&
    If a < 16 Then LongToString = "0" & Hex(a) Else LongToString = Hex(a)
    b = (Num And &HFF00&) \ 256
    If b < 16 Then LongToString = LongToString & "0" & Hex(b) Else LongToString = LongToString & Hex(b)
    c = (Num And &HFF0000) \ 65536
    If c < 16 Then LongToString = LongToString & "0" & Hex(c) Else LongToString = LongToString & Hex(c)
    If Num < 0 Then d = ((Num And &H7F000000) \ 16777216) Or &H80& Else d = (Num And &HFF000000) \ 16777216
    If d < 16 Then LongToString = LongToString & "0" & Hex(d) Else LongToString = LongToString & Hex(d)
    End Function
    Private Sub MD5Init()
    ByteCounter = 0
    State(1) = UnsignedToLong(1732584193#)
    State(2) = UnsignedToLong(4023233417#)
    State(3) = UnsignedToLong(2562383102#)
    State(4) = UnsignedToLong(271733878#)
    'Four 32bits link parameter
    End Sub
    Private Sub MD5Final()
    Dim dblBits As Double, padding(72) As Byte, lngBytesBuffered As Long
    padding(0) = &H80
    dblBits = ByteCounter * 8
    lngBytesBuffered = ByteCounter Mod 64
    If lngBytesBuffered <= 56 Then MD5Update 56 - lngBytesBuffered, padding Else MD5Update 120 - ByteCounter, padding
    padding(0) = UnsignedToLong(dblBits) And &HFF&
    padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
    padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
    padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
    padding(4) = 0
    padding(5) = 0
    padding(6) = 0
    padding(7) = 0
    MD5Update 8, padding
    End Sub
    Private Sub MD5Update(InputLen As Long, InputBuffer() As Byte)
    Dim II As Integer, i As Integer, j As Integer, k As Integer, lngBufferedBytes As Long, lngBufferRemaining As Long, lngRem As Long
    lngBufferedBytes = ByteCounter Mod 64
    lngBufferRemaining = 64 - lngBufferedBytes
    ByteCounter = ByteCounter + InputLen
    If InputLen >= lngBufferRemaining Then
    For II = 0 To lngBufferRemaining - 1
    ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
    Next II
    MD5Transform ByteBuffer
    lngRem = (InputLen) Mod 64
    For i = lngBufferRemaining To InputLen - II - lngRem Step 64
    For j = 0 To 63
    ByteBuffer(j) = InputBuffer(i + j)
    Next j
    MD5Transform ByteBuffer
    Next i
    lngBufferedBytes = 0
    Else
    i = 0
    End If
    For k = 0 To InputLen - i - 1
    ByteBuffer(lngBufferedBytes + k) = InputBuffer(i + k)
    Next k
    End Sub
    Private Sub MD5Transform(Buffer() As Byte)
    Dim X(16) As Long, a As Long, b As Long, c As Long, d As Long
    a = State(1)
    b = State(2)
    c = State(3)
    d = State(4)
    Decode 64, X, Buffer
    FF a, b, c, d, X(0), S11, -680876936
    FF d, a, b, c, X(1), S12, -389564586
    FF c, d, a, b, X(2), S13, 606105819
    FF b, c, d, a, X(3), S14, -1044525330
    FF a, b, c, d, X(4), S11, -176418897
    FF d, a, b, c, X(5), S12, 1200080426
    FF c, d, a, b, X(6), S13, -1473231341
    FF b, c, d, a, X(7), S14, -45705983
    FF a, b, c, d, X(8), S11, 1770035416
    FF d, a, b, c, X(9), S12, -1958414417
    FF c, d, a, b, X(10), S13, -42063
    FF b, c, d, a, X(11), S14, -1990404162
    FF a, b, c, d, X(12), S11, 1804603682
    FF d, a, b, c, X(13), S12, -40341101
    FF c, d, a, b, X(14), S13, -1502002290
    FF b, c, d, a, X(15), S14, 1236535329
    GG a, b, c, d, X(1), S21, -165796510
    GG d, a, b, c, X(6), S22, -1069501632
    GG c, d, a, b, X(11), S23, 643717713
    GG b, c, d, a, X(0), S24, -373897302
    GG a, b, c, d, X(5), S21, -701558691
    GG d, a, b, c, X(10), S22, 38016083
    GG c, d, a, b, X(15), S23, -660478335
    GG b, c, d, a, X(4), S24, -405537848
    GG a, b, c, d, X(9), S21, 568446438
    GG d, a, b, c, X(14), S22, -1019803690
    GG c, d, a, b, X(3), S23, -187363961
    GG b, c, d, a, X(8), S24, 1163531501
    GG a, b, c, d, X(13), S21, -1444681467
    GG d, a, b, c, X(2), S22, -51403784
    GG c, d, a, b, X(7), S23, 1735328473
    GG b, c, d, a, X(12), S24, -1926607734
    HH a, b, c, d, X(5), S31, -378558
    HH d, a, b, c, X(8), S32, -2022574463
    HH c, d, a, b, X(11), S33, 1839030562
    HH b, c, d, a, X(14), S34, -35309556
    HH a, b, c, d, X(1), S31, -1530992060
    HH d, a, b, c, X(4), S32, 1272893353
    HH c, d, a, b, X(7), S33, -155497632
    HH b, c, d, a, X(10), S34, -1094730640
    HH a, b, c, d, X(13), S31, 681279174
    HH d, a, b, c, X(0), S32, -358537222
    HH c, d, a, b, X(3), S33, -722521979
    HH b, c, d, a, X(6), S34, 76029189
    HH a, b, c, d, X(9), S31, -640364487
    HH d, a, b, c, X(12), S32, -421815835
    HH c, d, a, b, X(15), S33, 530742520
    HH b, c, d, a, X(2), S34, -995338651
    II a, b, c, d, X(0), S41, -198630844
    II d, a, b, c, X(7), S42, 1126891415
    II c, d, a, b, X(14), S43, -1416354905
    II b, c, d, a, X(5), S44, -57434055
    II a, b, c, d, X(12), S41, 1700485571
    II d, a, b, c, X(3), S42, -1894986606
    II c, d, a, b, X(10), S43, -1051523
    II b, c, d, a, X(1), S44, -2054922799
    II a, b, c, d, X(8), S41, 1873313359
    II d, a, b, c, X(15), S42, -30611744
    II c, d, a, b, X(6), S43, -1560198380
    II b, c, d, a, X(13), S44, 1309151649
    II a, b, c, d, X(4), S41, -145523070
    II d, a, b, c, X(11), S42, -1120210379
    II c, d, a, b, X(2), S43, 718787259
    II b, c, d, a, X(9), S44, -343485551
    State(1) = LongOverflowAdd(State(1), a)
    State(2) = LongOverflowAdd(State(2), b)
    State(3) = LongOverflowAdd(State(3), c)
    State(4) = LongOverflowAdd(State(4), d)
    End Sub
    Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte)
    Dim intDblIndex As Integer, intByteIndex As Integer, dblSum As Double
    For intByteIndex = 0 To Length - 1 Step 4
    dblSum = InputBuffer(intByteIndex) + InputBuffer(intByteIndex + 1) * 256# + InputBuffer(intByteIndex + 2) * 65536# + InputBuffer(intByteIndex + 3) * 16777216#
    OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
    intDblIndex = intDblIndex + 1
    Next intByteIndex
    End Sub
    Private Function FF(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long) As Long
    a = LongOverflowAdd4(a, (b And c) Or (Not (b) And d), X, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
    End Function
    Private Function GG(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long) As Long
    a = LongOverflowAdd4(a, (b And d) Or (c And Not (d)), X, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
    End Function
    Private Function HH(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long) As Long
    a = LongOverflowAdd4(a, b Xor c Xor d, X, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
    End Function
    Private Function II(a As Long, b As Long, c As Long, d As Long, X As Long, s As Long, ac As Long) As Long
    a = LongOverflowAdd4(a, c Xor (b Or Not (d)), X, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
    End Function
    Private Function LongLeftRotate(value As Long, Bits As Long) As Long
    Dim lngSign As Long, lngI As Long
    Bits = Bits Mod 32
    If Bits = 0 Then LongLeftRotate = value: Exit Function
    For lngI = 1 To Bits
    lngSign = value And &HC0000000
    value = (value And &H3FFFFFFF) * 2
    value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
    Next
    LongLeftRotate = value
    End Function
    Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
    Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
    lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
    lngOverflow = lngLowWord \ 65536
    lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
    LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
    End Function
    Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
    Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
    lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
    lngOverflow = lngLowWord \ 65536
    lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + ((val3 And &HFFFF0000) \ 65536) + ((val4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
    LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
    End Function
    Private Function UnsignedToLong(value As Double) As Long
    If value < 0 Or value >= OFFSET_4 Then Error 6
    If value <= MAXINT_4 Then UnsignedToLong = value Else UnsignedToLong = value - OFFSET_4
    End Function
    Private Function LongToUnsigned(value As Long) As Double
    If value < 0 Then LongToUnsigned = value + OFFSET_4 Else LongToUnsigned = value
    End Function
    

    同时对于MD5 以及Hash Map可以参阅 

     

    展开全文
  • vba md5 加密(支持16,32)

    千次阅读 2013-08-18 18:17:40
    在网上找到vba md5加密的方法,copy可以直接使用 Private Const BITS_TO_A_BYTE = 8 Private Const BYTES_TO_A_WORD = 4 Private Const BITS_TO_A_WORD = 32 Private m_lOnBits(30) Private m_l2Power(30) Private...

    在网上找到vba md5加密的方法,copy可以直接使用

    Private Const BITS_TO_A_BYTE = 8 Private Const BYTES_TO_A_WORD = 4 Private Const BITS_TO_A_WORD = 32

    Private m_lOnBits(30) Private m_l2Power(30)

    Private Function LShift(lValue, iShiftBits) If iShiftBits = 0 Then LShift = lValue Exit Function ElseIf iShiftBits = 31 Then If lValue And 1 Then LShift = &H80000000 Else LShift = 0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If

    If (lValue And m_l2Power(31 - iShiftBits)) Then LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000 Else LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits)) End If End Function

    Private Function RShift(lValue, iShiftBits) If iShiftBits = 0 Then RShift = lValue Exit Function ElseIf iShiftBits = 31 Then If lValue And &H80000000 Then RShift = 1 Else RShift = 0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If

    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1))) End If End Function

    Private Function RotateLeft(lValue, iShiftBits) RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) End Function

    Private Function AddUnsigned(lX, lY) Dim lX4 Dim lY4 Dim lX8 Dim lY8 Dim lResult

    lX8 = lX And &H80000000 lY8 = lY And &H80000000 lX4 = lX And &H40000000 lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then lResult = lResult Xor &H80000000 Xor lX8 Xor lY8 ElseIf lX4 Or lY4 Then If lResult And &H40000000 Then lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8 Else lResult = lResult Xor &H40000000 Xor lX8 Xor lY8 End If Else lResult = lResult Xor lX8 Xor lY8 End If

    AddUnsigned = lResult End Function

    Private Function md5_F(x, y, z) md5_F = (x And y) Or ((Not x) And z) End Function

    Private Function md5_G(x, y, z) md5_G = (x And z) Or (y And (Not z)) End Function

    Private Function md5_H(x, y, z) md5_H = (x Xor y Xor z) End Function

    Private Function md5_I(x, y, z) md5_I = (y Xor (x Or (Not z))) End Function

    Private Sub md5_FF(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub

    Private Sub md5_GG(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub

    Private Sub md5_HH(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub

    Private Sub md5_II(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub

    Private Function ConvertToWordArray(sMessage) Dim lMessageLength Dim lNumberOfWords Dim lWordArray() Dim lBytePosition Dim lByteCount Dim lWordCount

    Const MODULUS_BITS = 512 Const CONGRUENT_BITS = 448

    lMessageLength = Len(sMessage)

    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD) ReDim lWordArray(lNumberOfWords - 1)

    lBytePosition = 0 lByteCount = 0 Do Until lByteCount >= lMessageLength lWordCount = lByteCount \ BYTES_TO_A_WORD lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) lByteCount = lByteCount + 1 Loop

    lWordCount = lByteCount \ BYTES_TO_A_WORD lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3) lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

    ConvertToWordArray = lWordArray End Function

    Private Function WordToHex(lValue) Dim lByte Dim lCount

    For lCount = 0 To 3 lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) WordToHex = WordToHex & Right("0" & Hex(lByte), 2) Next End Function

    Public Function encodeMD5(sMessage, stype) m_lOnBits(0) = CLng(1) m_lOnBits(1) = CLng(3) m_lOnBits(2) = CLng(7) m_lOnBits(3) = CLng(15) m_lOnBits(4) = CLng(31) m_lOnBits(5) = CLng(63) m_lOnBits(6) = CLng(127) m_lOnBits(7) = CLng(255) m_lOnBits(8) = CLng(511) m_lOnBits(9) = CLng(1023) m_lOnBits(10) = CLng(2047) m_lOnBits(11) = CLng(4095) m_lOnBits(12) = CLng(8191) m_lOnBits(13) = CLng(16383) m_lOnBits(14) = CLng(32767) m_lOnBits(15) = CLng(65535) m_lOnBits(16) = CLng(131071) m_lOnBits(17) = CLng(262143) m_lOnBits(18) = CLng(524287) m_lOnBits(19) = CLng(1048575) m_lOnBits(20) = CLng(2097151) m_lOnBits(21) = CLng(4194303) m_lOnBits(22) = CLng(8388607) m_lOnBits(23) = CLng(16777215) m_lOnBits(24) = CLng(33554431) m_lOnBits(25) = CLng(67108863) m_lOnBits(26) = CLng(134217727) m_lOnBits(27) = CLng(268435455) m_lOnBits(28) = CLng(536870911) m_lOnBits(29) = CLng(1073741823) m_lOnBits(30) = CLng(2147483647)

    m_l2Power(0) = CLng(1) m_l2Power(1) = CLng(2) m_l2Power(2) = CLng(4) m_l2Power(3) = CLng(8) m_l2Power(4) = CLng(16) m_l2Power(5) = CLng(32) m_l2Power(6) = CLng(64) m_l2Power(7) = CLng(128) m_l2Power(8) = CLng(256) m_l2Power(9) = CLng(512) m_l2Power(10) = CLng(1024) m_l2Power(11) = CLng(2048) m_l2Power(12) = CLng(4096) m_l2Power(13) = CLng(8192) m_l2Power(14) = CLng(16384) m_l2Power(15) = CLng(32768) m_l2Power(16) = CLng(65536) m_l2Power(17) = CLng(131072) m_l2Power(18) = CLng(262144) m_l2Power(19) = CLng(524288) m_l2Power(20) = CLng(1048576) m_l2Power(21) = CLng(2097152) m_l2Power(22) = CLng(4194304) m_l2Power(23) = CLng(8388608) m_l2Power(24) = CLng(16777216) m_l2Power(25) = CLng(33554432) m_l2Power(26) = CLng(67108864) m_l2Power(27) = CLng(134217728) m_l2Power(28) = CLng(268435456) m_l2Power(29) = CLng(536870912) m_l2Power(30) = CLng(1073741824)

    Dim x Dim k Dim AA Dim BB Dim CC Dim DD Dim a Dim b Dim c Dim d

    Const S11 = 7 Const S12 = 12 Const S13 = 17 Const S14 = 22 Const S21 = 5 Const S22 = 9 Const S23 = 14 Const S24 = 20 Const S31 = 4 Const S32 = 11 Const S33 = 16 Const S34 = 23 Const S41 = 6 Const S42 = 10 Const S43 = 15 Const S44 = 21

    x = ConvertToWordArray(sMessage)

    a = &H67452301 b = &HEFCDAB89 c = &H98BADCFE d = &H10325476

    For k = 0 To UBound(x) Step 16 AA = a BB = b CC = c DD = d

    md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478 md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756 md5_FF c, d, a, b, x(k + 2), S13, &H242070DB md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A md5_FF c, d, a, b, x(k + 6), S13, &HA8304613 md5_FF b, c, d, a, x(k + 7), S14, &HFD469501 md5_FF a, b, c, d, x(k + 8), S11, &H698098D8 md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE md5_FF a, b, c, d, x(k + 12), S11, &H6B901122 md5_FF d, a, b, c, x(k + 13), S12, &HFD987193 md5_FF c, d, a, b, x(k + 14), S13, &HA679438E md5_FF b, c, d, a, x(k + 15), S14, &H49B40821

    md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562 md5_GG d, a, b, c, x(k + 6), S22, &HC040B340 md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51 md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D md5_GG d, a, b, c, x(k + 10), S22, &H2441453 md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681 md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6 md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87 md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905 md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9 md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A

    md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942 md5_HH d, a, b, c, x(k + 8), S32, &H8771F681 md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122 md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6 md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085 md5_HH b, c, d, a, x(k + 6), S34, &H4881D05 md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039 md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665

    md5_II a, b, c, d, x(k + 0), S41, &HF4292244 md5_II d, a, b, c, x(k + 7), S42, &H432AFF97 md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7 md5_II b, c, d, a, x(k + 5), S44, &HFC93A039 md5_II a, b, c, d, x(k + 12), S41, &H655B59C3 md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92 md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D md5_II b, c, d, a, x(k + 1), S44, &H85845DD1 md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 md5_II c, d, a, b, x(k + 6), S43, &HA3014314 md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1 md5_II a, b, c, d, x(k + 4), S41, &HF7537E82 md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235 md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB md5_II b, c, d, a, x(k + 9), S44, &HEB86D391

    a = AddUnsigned(a, AA) b = AddUnsigned(b, BB) c = AddUnsigned(c, CC) d = AddUnsigned(d, DD) Next

    If stype = 32 Then encodeMD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) Else encodeMD5 = LCase(WordToHex(b) & WordToHex(c)) End If End Function


    Md5PasswordEncoder这个类,是springsecurity内置的一个类。

    Md5PasswordEncoder md5 = new Md5PasswordEncoder();   
    System.out.println( md5.encodePassword("123456", "admin")); 
     
    其中encodePassword()函数的第一个参数是密码,第二个参数是salt值。 
    那么encodePassword()函数是怎么样吧rawPass和salt值结合起来的呢? 
    它的源代码是
    protected String mergePasswordAndSalt(String password, Object salt, boolean strict) {   
            if (password == null) {   
                password = "";   
            }   
      
            if (strict && (salt != null)) {   
                if ((salt.toString().lastIndexOf("{") != -1) || (salt.toString().lastIndexOf("}") != -1)) {   
                    throw new IllegalArgumentException("Cannot use { or } in salt.toString()");   
                }   
            }   
      
            if ((salt == null) || "".equals(salt)) {   
                return password;   
            } else {   
                return password + "{" + salt.toString() + "}";   
            }   
        }  
    


    
    

     

     

    为了做到,vba实现 类似 springSecurity加salt值

    需要先把  password=password +"{"+ salt.toString()+"}"

    然后再 MD5(password);

     

    vba 窗体调用md5模块

    Private Sub CommandButton1_Click()    TextBox3 = encodeMD5(TextBox1.Text, 32)    TextBox4 = encodeMD5(TextBox1.Text + "{" + TextBox2.Text + "}", 32)End Sub

    
    32位加密
    

     
     
    
    
    
    
    展开全文
  • 操作思路:1.使用 ADODB.stream 把字符串转换为UFT-8的编码集存储到文件 AA2....字符串截取第二行,去空格,输出MD5VBA代码:strBody = "VBA变量字符串转换为UFT-8后MD5加密"'MD5计算Dim stream As...
  • md5字符串加密 vba

    2011-03-04 11:13:32
    vba制作的md5字符串加密Demo,希望给大家带来帮助。
  • VBA MD5加密算法(转)

    2019-05-06 13:55:00
    AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub md5_II(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned...
  • 还是和之前的原因一个样,一直在用的 MD5 编码,处理英文时没问题,加了中文,就跟https://tool.oschina.net/encrypt?type=2和https://md5jiami.51240.com/的结果不一样了,想了下,应该还是 UTF-8 编码的问题,于是...
  • excel 中计算 MD5 的方法 直接引入到excel 文件中 进行MD5 计算 excel 中计算 MD5 的方法 直接引入到excel 文件中 进行MD5 计算
  • 尽管已“启用VBA宏”,Excel(Microsoft 365)还是无法运行宏。“可能是因为该宏在此工作簿中不可用,或者所有的宏都被禁用”。
  • ExcelVba 调用jQuery计算Md5 和 rsa

    千次阅读 2013-07-19 08:52:16
    Sub postdata() 'ExcelVba_调用jQuery计算Md5_和_rsa:——http://passport.58.com/login?path=http://my.58.com登录的POST参数的计算。用户名:abcd456,密码:mm = abcd123,这里要改用自己的密码和用户名。 Set ...
  • 文件的md5值计算.rar

    2022-01-04 12:49:30
    可获取指定文件夹所有文件的MD5
  • excel md5 函数宏

    热门讨论 2009-08-25 10:46:49
    excel md5 函数宏 excel md5 函数宏
  • 用于excel的md5宏xla

    热门讨论 2012-12-15 11:47:16
    用于excel 计算MD5码 可以计算32位、16位的 方便批量制作MD5
  • Excel版MD5加密

    2021-04-21 10:23:13
    MD5的典型应用是对一段信息(Message)产生信息摘要(Message-Digest),以防止被篡改
  • EXCEL VBA MD5 简单加密

    千次阅读 2013-11-15 16:37:55
    Function GetMD(s As String)  '引用 ComMD5 1.0 Type Library  '该类库定位于 msppmd5.dll   '使用命令:REGSVR32.EXE C:\msppmd5.dll 可以注册,保证md5文件路径正确即可注册 ...a.MD5Hash(s) End Funct
  • excel文件,以下操作以后md5值会不会变化调用的方法和步骤如下:1、首先,打开excel文档,如下图所示。2、其次,完成上述步骤后,Excel中有以下自定义函数,如下图所示。3、接着,完成上述步骤后,返回到Excel,可以...
  • HMAC-MD5 签名算法

    万次阅读 2018-06-27 14:35:39
    防止数据在传输过程被篡改,使用HMAC-MD5 签名算法校验数据。HMAC-MD5算法HMAC(K,M)=H(K⊕opad∣H(K⊕ipad∣M))其中:K是密钥(OperatorSecret),长度可为64字节,若小于该长度,在密钥后面用“0”补齐。 M...
  • VB6 MD5正确完整应用 含DLL和调用模块 和网上不同,这个是真正能用的,Vc写的动态库.
  • Excel VBA宏添加一些Markdown类型的语法以格式化Excel单元格内的字符 ##关于MD2E,它允许您使用某些Markdown类型的语法来格式化单元格内的字符,同时保留原始结构。 MD2E绑定到快捷键ctrl + shift + q。 ##安装...
  • excel的MD5函数宏

    千次阅读 2018-04-28 11:02:55
    收藏一个excel的md5宏,相当于给excel加了一个md5()函数,使用时需要加一个lower()函数,可获得小写的32位md5加密字符串。附2013版office加载方法:在选项中调开开发者工具,然后在开发工具中点击加载宏就可以了。...
  • 对文件的相似度,进行比较能够快速的找出重复文件
  • MD5实现Token校验

    千次阅读 2018-05-11 10:19:54
    MessageDigest md = MessageDigest.getInstance("MD5"); resultString = byteArrayToHexString(md.digest(resultString .getBytes("UTF-8"))); } catch (Exception exception) { } return resultString; } ...
  • Sub ExcelVba_调用jQuery计算Md5() Set doc = CreateObject("htmlfile") Set scr = doc.createelement("script") scr.src = "http://code.jquery.com/jquery-1.10.2.min.js" doc.body.appendchild s
  • VBA彻底解决MD5加密中文不一致问题

    千次阅读 2013-07-01 02:26:37
    var hexcase = 0;...function hex_md5(a) { return rstr2hex(rstr_md5(str2rstr_utf8(a))) } function hex_hmac_md5(a, b) { return rstr2hex(rstr_hmac_md5(str2rstr_utf8(a), str2rstr_utf8(b))) }
  • VBA:Excel小工具

    2021-05-11 14:32:02
    Excel调用MD5宏使用文档 一.说明 宏文件名称:md5.xla MD5加密方式:32位加密,大写 调用加密函数:Md5_String_Calc() 二.加载步骤 1.打开Excel,点击左上角“文件”,然后选择“选项” 2.点选“自定义功能区” 3....

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 981
精华内容 392
热门标签
关键字:

md5vba