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 FunctionPrivate 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 FunctionPrivate Function RotateLeft(lValue, iShiftBits)
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End FunctionPrivate 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

解决方案 »

  1.   

    Private Function Ch(x, y, z)
        Ch = ((x And y) Xor ((Not x) And z))
    End FunctionPrivate Function Maj(x, y, z)
        Maj = ((x And y) Xor (x And z) Xor (y And z))
    End FunctionPrivate Function S(x, n)
        S = (RShift(x, (n And m_lOnBits(4))) Or LShift(x, (32 - (n And m_lOnBits(4)))))
    End FunctionPrivate Function R(x, n)
        R = RShift(x, cLng(n And m_lOnBits(4)))
    End FunctionPrivate Function Sigma0(x)
        Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))
    End FunctionPrivate Function Sigma1(x)
        Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))
    End FunctionPrivate Function Gamma0(x)
        Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))
    End FunctionPrivate Function Gamma1(x)
        Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))
    End FunctionPrivate Function ConvertToWordArray(sMessage)
        Dim lMessageLength
        Dim lNumberOfWords
        Dim lWordArray()
        Dim lBytePosition
        Dim lByteCount
        Dim lWordCount
        Dim lByte
        
        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 = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
            
            lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
            
            lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
            lByteCount = lByteCount + 1
        Loop    lWordCount = lByteCount \ BYTES_TO_A_WORD
        lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)    lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
        lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)
        
        ConvertToWordArray = lWordArray
    End FunctionPrivate 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 FunctionPublic Function MD5(sMessage)
        Dim HASH(7)
        Dim M
        Dim W(63)
        Dim a
        Dim b
        Dim c
        Dim d
        Dim e
        Dim f
        Dim g
        Dim h
        Dim i
        Dim j
        Dim T1
        Dim T2'    HASH(0) = &H6A09E667
    '    HASH(1) = &HBB67AE85
    '    HASH(2) = &H3C6EF372
    '    HASH(3) = &HA54FF53A
    '    HASH(4) = &H510E527F
    '    HASH(5) = &H9B05688C
    '    HASH(6) = &H1F83D9AB
    '    HASH(7) = &H5BE0CD19
        
        HASH(0) = &H6A09E993
        HASH(1) = &HBB67AA93
        HASH(2) = &H3C6EAE85
        HASH(3) = &HA54F7F52
        HASH(4) = &H510EABD9
        HASH(5) = &H9B0511AE
        HASH(6) = &H1F83688C
        HASH(7) = &H5BE0CE13
        
        M = ConvertToWordArray(sMessage)
        
        For i = 0 To UBound(M) Step 16
            a = HASH(0)
            b = HASH(1)
            c = HASH(2)
            d = HASH(3)
            e = HASH(4)
            f = HASH(5)
            g = HASH(6)
            h = HASH(7)
            
            For j = 0 To 63
                If j < 16 Then
                    W(j) = M(j + i)
                Else
                    W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))
                End If
                    
                T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), Ch(e, f, g)), K(j)), W(j))
                T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))
                
                h = g
                g = f
                f = e
                e = AddUnsigned(d, T1)
                d = c
                c = b
                b = a
                a = AddUnsigned(T1, T2)
            Next
            
            HASH(0) = AddUnsigned(a, HASH(0))
            HASH(1) = AddUnsigned(b, HASH(1))
            HASH(2) = AddUnsigned(c, HASH(2))
            HASH(3) = AddUnsigned(d, HASH(3))
            HASH(4) = AddUnsigned(e, HASH(4))
            HASH(5) = AddUnsigned(f, HASH(5))
            HASH(6) = AddUnsigned(g, HASH(6))
            HASH(7) = AddUnsigned(h, HASH(7))
        Next
        
        MD5= LCase(Right("00000000" & Hex(HASH(0)), 8) & Right("00000000" & Hex(HASH(1)), 8) & Right("00000000" & Hex(HASH(2)), 8) & Right("00000000" & Hex(HASH(3)), 8) & Right("00000000" & Hex(HASH(4)), 8) & Right("00000000" & Hex(HASH(5)), 8) & Right("00000000" & Hex(HASH(6)), 8) & Right("00000000" & Hex(HASH(7)), 8))
    End Function
    %>
      

  2.   

    杀了我吧!
    PHP有MD5函数!而且用起来很方便!
    为什么要重写?
      

  3.   

    如题,因为我原来用的MD5里面有几个数是变化过的,所以用php的md5算不出我要的值