对于Excel VBA的密码哈希函数(Password hash function for Exce

2019-06-18 07:51发布

站内文章 / 后端开发
24 0 0

我需要写在Excel中VBA函数，将哈希使用标准算法，如SHA-1密码。 东西用一个简单的接口，如： 

Public Function CreateHash(Value As String) As String
...
End Function

该功能需要使用Excel 2003安装的XP工作站上工作，但必须以其他方式使用任何第三方组件。 它可以参考和使用的DLL中可用的XP，如CryptoAPI的。

有谁知道一个样本实现这个散列功能？

Answer 1:

你会发现VB和VBScript的MD5和SHA256执行这里 。

我相信，这将是很容易移植到Excel。

但是有人已经这样做了。 不幸的是，解决方案是在专家交换不允许直接链接。 因此，我们必须去通过谷歌。 点击这里进行谷歌搜索，然后点击第一个结果。 向下滚动很多看到接受的解决方案。



Answer 2:

下面是计算SHA1哈希值是为Excel公式如可用的模块。 '= SHA1HASH（ “测试”）'。 要使用它，创建一个名为“module_sha1”新的模块复制并粘贴所有英寸，这是基于一些VBA代码http://vb.wikia.com/wiki/SHA-1.bas ，同时改变支持传递一个字符串，并在Excel单元格的公式可执行文件。 

' Based on: http://vb.wikia.com/wiki/SHA-1.bas
Option Explicit

Private Type FourBytes
    A As Byte
    B As Byte
    C As Byte
    D As Byte
End Type
Private Type OneLong
    L As Long
End Type

Function HexDefaultSHA1(Message() As Byte) As String
 Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
 DefaultSHA1 Message, H1, H2, H3, H4, H5
 HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
 Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
 xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
 HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
 xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub

Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
 'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
 '"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"

 Dim U As Long, P As Long
 Dim FB As FourBytes, OL As OneLong
 Dim i As Integer
 Dim W(80) As Long
 Dim A As Long, B As Long, C As Long, D As Long, E As Long
 Dim T As Long

 H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0

 U = UBound(Message) + 1: OL.L = U32ShiftLeft3(U): A = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)

 ReDim Preserve Message(0 To (U + 8 And -64) + 63)
 Message(U) = 128

 U = UBound(Message)
 Message(U - 4) = A
 Message(U - 3) = FB.D
 Message(U - 2) = FB.C
 Message(U - 1) = FB.B
 Message(U) = FB.A

 While P < U
     For i = 0 To 15
         FB.D = Message(P)
         FB.C = Message(P + 1)
         FB.B = Message(P + 2)
         FB.A = Message(P + 3)
         LSet OL = FB
         W(i) = OL.L
         P = P + 4
     Next i

     For i = 16 To 79
         W(i) = U32RotateLeft1(W(i - 3) Xor W(i - 8) Xor W(i - 14) Xor W(i - 16))
     Next i

     A = H1: B = H2: C = H3: D = H4: E = H5

     For i = 0 To 19
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key1), ((B And C) Or ((Not B) And D)))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 20 To 39
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key2), (B Xor C Xor D))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 40 To 59
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key3), ((B And C) Or (B And D) Or (C And D)))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 60 To 79
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key4), (B Xor C Xor D))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i

     H1 = U32Add(H1, A): H2 = U32Add(H2, B): H3 = U32Add(H3, C): H4 = U32Add(H4, D): H5 = U32Add(H5, E)
 Wend
End Sub

Function U32Add(ByVal A As Long, ByVal B As Long) As Long
 If (A Xor B) < 0 Then
     U32Add = A + B
 Else
     U32Add = (A Xor &H80000000) + B Xor &H80000000
 End If
End Function

Function U32ShiftLeft3(ByVal A As Long) As Long
 U32ShiftLeft3 = (A And &HFFFFFFF) * 8
 If A And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function

Function U32ShiftRight29(ByVal A As Long) As Long
 U32ShiftRight29 = (A And &HE0000000) \ &H20000000 And 7
End Function

Function U32RotateLeft1(ByVal A As Long) As Long
 U32RotateLeft1 = (A And &H3FFFFFFF) * 2
 If A And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
 If A And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal A As Long) As Long
 U32RotateLeft5 = (A And &H3FFFFFF) * 32 Or (A And &HF8000000) \ &H8000000 And 31
 If A And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal A As Long) As Long
 U32RotateLeft30 = (A And 1) * &H40000000 Or (A And &HFFFC) \ 4 And &H3FFFFFFF
 If A And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function

Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
 Dim H As String, L As Long
 DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
 H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
 H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
 H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
 H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
 H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function

' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog

Public Function SHA1HASH(str)
  Dim i As Integer
  Dim arr() As Byte
  ReDim arr(0 To Len(str) - 1) As Byte
  For i = 0 To Len(str) - 1
   arr(i) = Asc(Mid(str, i + 1, 1))
  Next i
  SHA1HASH = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function


Answer 3:

下面是插入在Excel模块具有名称“module_md5”的MD5代码： 

    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)

    Sub SetUpArrays()
        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)
    End Sub

    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 F(x, y, z)
        F = (x And y) Or ((Not x) And z)
    End Function

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

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

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

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

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

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

    Private Sub II(a, b, c, d, x, s, ac)
        a = AddUnsigned(a, AddUnsigned(AddUnsigned(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)

        module_md5.SetUpArrays

        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

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

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

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

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

        MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
    End Function


Answer 4:

这些天来，你可以利用VBA中的.NET库。 在Excel 2016年对我来说，以下的作品返回哈希为大写十六进制。 

Public Function SHA1(ByVal s As String) As String
    Dim Enc As Object, Prov As Object
    Dim Hash() As Byte, i As Integer

    Set Enc = CreateObject("System.Text.UTF8Encoding")
    Set Prov = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")

    Hash = Prov.ComputeHash_2(Enc.GetBytes_4(s))

    SHA1 = ""
    For i = LBound(Hash) To UBound(Hash)
        SHA1 = SHA1 & Hex(Hash(i) \ 16) & Hex(Hash(i) Mod 16)
    Next
End Function


文章来源: Password hash function for Excel VBA
标签： excel vba hash sha1
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~