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 '模2的32次方的加法运算 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
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
LShift和RShift字面上的意思就是左移位和右移位。 为方便表达,此处以8位无符号整数为例: dim a as byte:a=20 'dec(20)=bin(00010100) LShift(a,1)=40'LShift(bin(00010100),1)=bin(00101000)=dec(40) LShift(a,4)=64'LShift(bin(00010100),4)=bin(01000000)=dec(64) '00010100->00101000->01010000->10100000->01000000