www.pudn.com > QQ2005Pwd.rar > modMD5.bas
Attribute VB_Name = "modMD5"
Option Explicit
'===========================================================================
' Code Name: MD5计算模块
' First Built: 2001-12-18
' Last Modify: 2003-10-10
' Author: 赵斌（Binny）
' Copyright: Binny，转载请保留本声明
'===========================================================================
'2001年12月18日 根据 rfc1321.txt 编制VB代码
'2003年10月10日 修改函数 Public Function INNER_MD5(fsInput As String) As String --> _
Public Function INNER_MD5(fsInput As String, fbIsHex As Boolean) As String
'
'MD5("") = d41d8cd98f00b204e9800998ecf8427e
'MD5 ("a") = 0cc175b9c0f1b6a831c399e269772661
'MD5 ("abc") = 900150983cd24fb0d6963f7d28e17f72
'MD5("message digest") = f96b697d7cb7938d525a2f31aaf161d0
'MD5("abcdefghijklmnopqrstuvwxyz") = c3fcd3d76192e4007dfb496cca67e13b
'MD5("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") = d174ab98d277d9f5a5611c2c9f419d9f
'MD5 ("12345678901234567890123456789012345678901234567890123456789012345678901234567890") = 57edf4a22be3c955ac49da2e2107b67a
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 INNER_MD5(fsInput As String, Optional fbIsHex As Boolean) As String
Dim lLen As Long, iTemp1 As Long, iTemp2 As Long
Dim k As Long, m As Long, n As Long
Dim a As Long, b As Long, c As Long, d As Long
Dim sResult As String
Dim sInput As String
Dim byt() As Byte
ReDim lbuf(0 To 3) As Long
ReDim x(0 To 15) As Long
If fsInput <> "" Then
If fbIsHex Then
byt = INNER_Hex2ByteA(fsInput)
lLen = Len(fsInput) / 2
Else
byt = INNER_Str2ByteA(fsInput, lLen)
End If
End If
iTemp1 = lLen * 8
iTemp2 = 56 - (lLen + 1) Mod 64
If iTemp2 < 0 Then
iTemp2 = 64 + iTemp2
End If
ReDim Preserve byt(lLen + iTemp2 + 8)
byt(lLen) = 128 'Add binary 10000000
For k = 1 To 8
byt(lLen + iTemp2 + k) = iTemp1 Mod 256
iTemp1 = iTemp1 - iTemp1 Mod 256
iTemp1 = iTemp1 \ 256
Next k
lbuf(0) = &H67452301
lbuf(1) = &HEFCDAB89
lbuf(2) = &H98BADCFE
lbuf(3) = &H10325476
For m = 0 To (UBound(byt) + 1) \ 64 - 1
a = lbuf(0)
b = lbuf(1)
c = lbuf(2)
d = lbuf(3)
For k = 0 To 15
sInput = ""
' Debug.Assert k <> 14
For n = 1 To 4
sInput = Hex$(byt(64 * m + 4 * k + n - 1)) & sInput
If Len(sInput) Mod 2 Then sInput = "0" & sInput
Next n
x(k) = CLng("&H" & sInput)
Next k
Call Lo_lFF(a, b, c, d, x(0), S11, &HD76AA478) '; /* 1 */
Call Lo_lFF(d, a, b, c, x(1), S12, &HE8C7B756) '; /* 2 */
Call Lo_lFF(c, d, a, b, x(2), S13, &H242070DB) '; /* 3 */
Call Lo_lFF(b, c, d, a, x(3), S14, &HC1BDCEEE) '; /* 4 */
Call Lo_lFF(a, b, c, d, x(4), S11, &HF57C0FAF) '; /* 5 */
Call Lo_lFF(d, a, b, c, x(5), S12, &H4787C62A) '; /* 6 */
Call Lo_lFF(c, d, a, b, x(6), S13, &HA8304613) '; /* 7 */
Call Lo_lFF(b, c, d, a, x(7), S14, &HFD469501) '; /* 8 */
Call Lo_lFF(a, b, c, d, x(8), S11, &H698098D8) '; /* 9 */
Call Lo_lFF(d, a, b, c, x(9), S12, &H8B44F7AF) '; /* 10 */
Call Lo_lFF(c, d, a, b, x(10), S13, &HFFFF5BB1) '; /* 11 */
Call Lo_lFF(b, c, d, a, x(11), S14, &H895CD7BE) '; /* 12 */
Call Lo_lFF(a, b, c, d, x(12), S11, &H6B901122) '; /* 13 */
Call Lo_lFF(d, a, b, c, x(13), S12, &HFD987193) '; /* 14 */
Call Lo_lFF(c, d, a, b, x(14), S13, &HA679438E) '; /* 15 */
Call Lo_lFF(b, c, d, a, x(15), S14, &H49B40821) '; /* 16 */
Call Lo_lGG(a, b, c, d, x(1), S21, &HF61E2562) '; /* 17 */
Call Lo_lGG(d, a, b, c, x(6), S22, &HC040B340) '; /* 18 */
Call Lo_lGG(c, d, a, b, x(11), S23, &H265E5A51) '; /* 19 */
Call Lo_lGG(b, c, d, a, x(0), S24, &HE9B6C7AA) '; /* 20 */
Call Lo_lGG(a, b, c, d, x(5), S21, &HD62F105D) '; /* 21 */
Call Lo_lGG(d, a, b, c, x(10), S22, &H2441453) '; /* 22 */
Call Lo_lGG(c, d, a, b, x(15), S23, &HD8A1E681) '; /* 23 */
Call Lo_lGG(b, c, d, a, x(4), S24, &HE7D3FBC8) '; /* 24 */
Call Lo_lGG(a, b, c, d, x(9), S21, &H21E1CDE6) '; /* 25 */
Call Lo_lGG(d, a, b, c, x(14), S22, &HC33707D6) '; /* 26 */
Call Lo_lGG(c, d, a, b, x(3), S23, &HF4D50D87) '; /* 27 */
Call Lo_lGG(b, c, d, a, x(8), S24, &H455A14ED) '; /* 28 */
Call Lo_lGG(a, b, c, d, x(13), S21, &HA9E3E905) '; /* 29 */
Call Lo_lGG(d, a, b, c, x(2), S22, &HFCEFA3F8) '; /* 30 */
Call Lo_lGG(c, d, a, b, x(7), S23, &H676F02D9) '; /* 31 */
Call Lo_lGG(b, c, d, a, x(12), S24, &H8D2A4C8A) '; /* 32 */
Call Lo_lHH(a, b, c, d, x(5), S31, &HFFFA3942) '; /* 33 */
Call Lo_lHH(d, a, b, c, x(8), S32, &H8771F681) '; /* 34 */
Call Lo_lHH(c, d, a, b, x(11), S33, &H6D9D6122) '; /* 35 */
Call Lo_lHH(b, c, d, a, x(14), S34, &HFDE5380C) '; /* 36 */
Call Lo_lHH(a, b, c, d, x(1), S31, &HA4BEEA44) '; /* 37 */
Call Lo_lHH(d, a, b, c, x(4), S32, &H4BDECFA9) '; /* 38 */
Call Lo_lHH(c, d, a, b, x(7), S33, &HF6BB4B60) '; /* 39 */
Call Lo_lHH(b, c, d, a, x(10), S34, &HBEBFBC70) '; /* 40 */
Call Lo_lHH(a, b, c, d, x(13), S31, &H289B7EC6) '; /* 41 */
Call Lo_lHH(d, a, b, c, x(0), S32, &HEAA127FA) '; /* 42 */
Call Lo_lHH(c, d, a, b, x(3), S33, &HD4EF3085) '; /* 43 */
Call Lo_lHH(b, c, d, a, x(6), S34, &H4881D05) '; /* 44 */
Call Lo_lHH(a, b, c, d, x(9), S31, &HD9D4D039) '; /* 45 */
Call Lo_lHH(d, a, b, c, x(12), S32, &HE6DB99E5) '; /* 46 */
Call Lo_lHH(c, d, a, b, x(15), S33, &H1FA27CF8) '; /* 47 */
Call Lo_lHH(b, c, d, a, x(2), S34, &HC4AC5665) '; /* 48 */
Call Lo_lII(a, b, c, d, x(0), S41, &HF4292244) '; /* 49 */
Call Lo_lII(d, a, b, c, x(7), S42, &H432AFF97) '; /* 50 */
Call Lo_lII(c, d, a, b, x(14), S43, &HAB9423A7) '; /* 51 */
Call Lo_lII(b, c, d, a, x(5), S44, &HFC93A039) '; /* 52 */
Call Lo_lII(a, b, c, d, x(12), S41, &H655B59C3) '; /* 53 */
Call Lo_lII(d, a, b, c, x(3), S42, &H8F0CCC92) '; /* 54 */
Call Lo_lII(c, d, a, b, x(10), S43, &HFFEFF47D) '; /* 55 */
Call Lo_lII(b, c, d, a, x(1), S44, &H85845DD1) '; /* 56 */
Call Lo_lII(a, b, c, d, x(8), S41, &H6FA87E4F) '; /* 57 */
Call Lo_lII(d, a, b, c, x(15), S42, &HFE2CE6E0) '; /* 58 */
Call Lo_lII(c, d, a, b, x(6), S43, &HA3014314) '; /* 59 */
Call Lo_lII(b, c, d, a, x(13), S44, &H4E0811A1) '; /* 60 */
Call Lo_lII(a, b, c, d, x(4), S41, &HF7537E82) '; /* 61 */
Call Lo_lII(d, a, b, c, x(11), S42, &HBD3AF235) '; /* 62 */
Call Lo_lII(c, d, a, b, x(2), S43, &H2AD7D2BB) '; /* 63 */
Call Lo_lII(b, c, d, a, x(9), S44, &HEB86D391) '; /* 64 */
lbuf(0) = Lo_Add2Value(lbuf(0), a)
lbuf(1) = Lo_Add2Value(lbuf(1), b)
lbuf(2) = Lo_Add2Value(lbuf(2), c)
lbuf(3) = Lo_Add2Value(lbuf(3), d)
Next m
sResult = ""
For k = 0 To 3
sInput = INNER_Format(Hex$(lbuf(k)), "00000000")
For n = 3 To 0 Step -1
sResult = sResult & Mid$(sInput, 1 + 2 * n, 2)
Next n
Next k
INNER_MD5 = sResult
End Function
Private Function Lo_lAddMD5(ByVal fsInput As Long, ByVal a As Long, ByVal b As Long, ByVal x As Long, ByVal ac As Long, ByVal s As Integer) As Long
' (a) += F ((b), (c), (d)) + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Lo_lAddMD5 = Lo_Add2Value(Lo_lRotLeft(Lo_Add2Value(Lo_Add2Value(a, fsInput), Lo_Add2Value(x, ac)), s), b)
End Function
'#define LoFF(a, b, c, d, x, s, ac) { \
' (a) += F ((b), (c), (d)) + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Private Sub Lo_lFF(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Integer, ByVal ac As Long)
a = Lo_lAddMD5(Lo_lF(b, c, d), a, b, x, ac, s)
End Sub
'#define F(x, y, z) (((x) & (y)) | ((~x) & (z)))
Private Function Lo_lF(x As Long, y As Long, z As Long) As String
Lo_lF = (x And y) Or (z And (&HFFFFFFFF - x))
End Function
'#define LoGG(a, b, c, d, x, s, ac) { \
' (a) += G ((b), (c), (d)) + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Private Sub Lo_lGG(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Integer, ByVal ac As Long)
a = Lo_lAddMD5(Lo_lG(b, c, d), a, b, x, ac, s)
End Sub
'#define G(x, y, z) (((x) & (z)) | ((y) & (~z)))
Private Function Lo_lG(x As Long, y As Long, z As Long) As String
Lo_lG = (x And z) Or (y And (&HFFFFFFFF - z))
End Function
'#define LoHH(a, b, c, d, x, s, ac) { \
' (a) += H ((b), (c), (d)) + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Private Sub Lo_lHH(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Integer, ByVal ac As Long)
a = Lo_lAddMD5(Lo_lH(b, c, d), a, b, x, ac, s)
End Sub
'#define H(x, y, z) ((x) ^ (y) ^ (z))
Private Function Lo_lH(x As Long, y As Long, z As Long) As String
Lo_lH = y Xor x Xor z
End Function
'#define LoII(a, b, c, d, x, s, ac) { \
' (a) += I ((b), (c), (d)) + (x) + (UINT4)(ac); \
' (a) = ROTATE_LEFT ((a), (s)); \
' (a) += (b); \
' }
Private Sub Lo_lII(a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal x As Long, ByVal s As Integer, ByVal ac As Long)
a = Lo_lAddMD5(Lo_lI(b, c, d), a, b, x, ac, s)
End Sub
'#define I(x, y, z) ((y) ^ ((x) | (~z)))
Private Function Lo_lI(x As Long, y As Long, z As Long) As String
Lo_lI = y Xor (x Or (&HFFFFFFFF - z))
End Function
Private Function Lo_Add2Value(flValueA As Long, flValueB As Long) As Long
Dim lValueLoA As Long
Dim lValueLoB As Long
Dim lValueHiA As Long
Dim lValueHiB As Long
lValueHiA = flValueA And &H80000000
lValueHiB = flValueB And &H80000000
lValueLoA = flValueA And &H40000000
lValueLoB = flValueB And &H40000000
Lo_Add2Value = (flValueA And &H3FFFFFFF) + (flValueB And &H3FFFFFFF)
If lValueLoA And lValueLoB Then
Lo_Add2Value = Lo_Add2Value Xor &H80000000 Xor lValueHiA Xor lValueHiB
ElseIf lValueLoA Or lValueLoB Then
If Lo_Add2Value And &H40000000 Then
Lo_Add2Value = Lo_Add2Value Xor &HC0000000 Xor lValueHiA Xor lValueHiB
Else
Lo_Add2Value = Lo_Add2Value Xor &H40000000 Xor lValueHiA Xor lValueHiB
End If
Else
Lo_Add2Value = Lo_Add2Value Xor lValueHiA Xor lValueHiB
End If
End Function
'#define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32-(n))))
Private Function Lo_lRotLeft(ByVal flInput As Long, ByVal flRots As Long) As Long
Dim lTempLeft As Long, lTempRight As Long
If flInput = 0 Then Exit Function
flRots = flRots Mod 32
If flRots = 0 Then
Lo_lRotLeft = flInput
Exit Function
End If
lTempLeft = flInput And (2 ^ (32 - flRots) - 1)
If lTempLeft > 2 ^ (31 - flRots) - 1 Then
lTempLeft = lTempLeft - 2 ^ (31 - flRots)
lTempLeft = lTempLeft * (2 ^ flRots)
lTempLeft = lTempLeft Or &H80000000
Else
lTempLeft = lTempLeft * (2 ^ flRots)
End If
If flInput < 0 Then
lTempRight = flInput And &H7FFFFFFF
lTempRight = lTempRight \ 2 ^ (32 - flRots)
lTempRight = lTempRight Or (2 ^ (flRots - 1))
Else
lTempRight = flInput \ 2 ^ (32 - flRots)
End If
Lo_lRotLeft = CLng(lTempLeft) Or lTempRight
End Function
Public Function INNER_Format(InputStr As String, FormatStr As String) As String
If Len(InputStr) >= Len(FormatStr) Then
INNER_Format = Left(InputStr, Len(FormatStr))
Else
INNER_Format = Left(FormatStr, Len(FormatStr) - Len(InputStr)) & InputStr
End If
End Function