MD5在VB中的实现

Option Explicit
Dim w1 As String, w2 As String, w3 As String, w4 As String
Function md5f(ByVal tempstr As String, ByVal w As String, ByVal x As String, ByVal y As String, ByVal z As String, ByVal xin As String, ByVal qdata As String, ByVal rots As Integer)
    md5f = bigmod32add(rotleft(bigmod32add(bigmod32add(w, tempstr), bigmod32add(xin, qdata)), rots), x)
End Function
Sub md5f1(w As String, ByVal x As String, ByVal y As String, ByVal z As String, ByVal xin As String, ByVal qdata As String, ByVal rots As Integer)
Dim tempstr As String
    tempstr = bigxor(z, bigand(x, bigxor(y, z)))
    w = md5f(tempstr, w, x, y, z, xin, qdata, rots)
End Sub
Sub md5f2(w As String, ByVal x As String, ByVal y As String, ByVal z As String, ByVal xin As String, ByVal qdata As String, ByVal rots As Integer)
Dim tempstr As String
    tempstr = bigxor(y, bigand(z, bigxor(x, y)))
    w = md5f(tempstr, w, x, y, z, xin, qdata, rots)
End Sub
Sub md5f3(w As String, ByVal x As String, ByVal y As String, ByVal z As String, ByVal xin As String, ByVal qdata As String, ByVal rots As Integer)
Dim tempstr As String
    tempstr = bigxor(x, bigxor(y, z))
    w = md5f(tempstr, w, x, y, z, xin, qdata, rots)
End Sub
Sub md5f4(w As String, ByVal x As String, ByVal y As String, ByVal z As String, ByVal xin As String, ByVal qdata As String, ByVal rots As Integer)
Dim tempstr As String
    tempstr = bigxor(y, bigor(x, bignot(z)))
    w = md5f(tempstr, w, x, y, z, xin, qdata, rots)
End Sub
Function md5_calc(ByVal hashthis As String) As String
ReDim buf(0 To 3) As String
ReDim xin(0 To 15) As String
Dim tempnum As Integer, tempnum2 As Integer, loopit As Integer, loopou
ter As Integer, loopinner As Integer
Dim a As String, b As String, c As String, d As String
    ' add padding
    tempnum = 8 * Len(hashthis)
    hashthis = hashthis + Chr$(128) 'add binary 10000000
    tempnum2 = 56 - Len(hashthis) Mod 64
    If tempnum2 < 0 Then
        tempnum2 = 64 + tempnum2
    End If
    hashthis = hashthis + String$(tempnum2, Chr$(0))
    For loopit = 1 To 8
        hashthis = hashthis + Chr$(tempnum Mod 256)
        tempnum = tempnum - tempnum Mod 256
        tempnum = tempnum / 256
    Next loopit
    
    ' set magic numbers
    buf(0) = "67452301"
    buf(1) = "efcdab89"
    buf(2) = "98badcfe"
    buf(3) = "10325476"
    
    ' for each 512 bit section
    For loopouter = 0 To Len(hashthis) / 64 - 1
        a = buf(0)
        b = buf(1)
        c = buf(2)
        d = buf(3)
        ' get the 512 bits
        For loopit = 0 To 15
            xin(loopit) = ""
            For loopinner = 1 To 4
                xin(loopit) = Hex$(Asc(Mid$(hashthis, 64 * loopouter + 4 * loopit + loopinner, 1))) + xin(loopit)
                If Len(xin(loopit)) Mod 2 Then xin(loopit) = "0" + xin(loopit)
            Next loopinner
        Next loopit
        ' round 1
        md5f1 a, b, c, d, xin(0), "d76aa478", 7
        md5f1 d, a, b, c, xin(1), "e8c7b756", 12
        md5f1 c, d, a, b, xin(2), "242070db", 17
        md5f1 b, c, d, a, xin(3), "c1bdceee", 22
        md5f1 a, b, c, d, xin(4), "f57c0faf", 7
        md5f1 d, a, b, c, xin(5), "4787c62a", 12
        md5f1 c, d, a, b, xin(6), "a8304613", 17
        md5f1 b, c, d, a, xin(7), "fd469501", 22
        md5f1 a, b, c, d, xin(8), "698098d8", 7
        md5f1 d, a, b, c, xin(9), "8b44f7af", 12
        md5f1 c, d, a, b, xin(10), "ffff5bb1", 17
        md5f1 b, c, d, a, xin(11), "895cd7be", 22
        md5f1 a, b, c, d, xin(12), "6b901122", 7
        md5f1 d, a, b, c, xin(13), "fd987193", 12
        md5f1 c, d, a, b, xin(14), "a679438e", 17
        md5f1 b, c, d, a, xin(15), "49b40821", 22
        ' round 2
        md5f2 a, b, c, d, xin(1), "f61e2562", 5
        md5f2 d, a, b, c, xin(6), "c040b340", 9
        md5f2 c, d, a, b, xin(11), "265e5a51", 14
        md5f2 b, c, d, a, xin(0), "e9b6c7aa", 20
        md5f2 a, b, c, d, xin(5), "d62f105d", 5
        md5f2 d, a, b, c, xin(10), "02441453", 9
        md5f2 c, d, a, b, xin(15), "d8a1e681", 14
        md5f2 b, c, d, a, xin(4), "e7d3fbc8", 20
        md5f2 a, b, c, d, xin(9), "21e1cde6", 5
        md5f2 d, a, b, c, xin(14), "c33707d6", 9
        md5f2 c, d, a, b, xin(3), "f4d50d87", 14
        md5f2 b, c, d, a, xin(8), "455a14ed", 20
        md5f2 a, b, c, d, xin(13), "a9e3e905", 5
        md5f2 d, a, b, c, xin(2), "fcefa3f8", 9
        md5f2 c, d, a, b, xin(7), "676f02d9", 14
        md5f2 b, c, d, a, xin(12), "8d2a4c8a", 20
        ' round 3
        md5f3 a, b, c, d, xin(5), "fffa3942", 4
        md5f3 d, a, b, c, xin(8), "8771f681", 11
        md5f3 c, d, a, b, xin(11), "6d9d6122", 16
        md5f3 b, c, d, a, xin(14), "fde5380c", 23
        md5f3 a, b, c, d, xin(1), "a4beea44", 4
        md5f3 d, a, b, c, xin(4), "4bdecfa9", 11
        md5f3 c, d, a, b, xin(7), "f6bb4b60", 16
        md5f3 b, c, d, a, xin(10), "bebfbc70", 23
        md5f3 a, b, c, d, xin(13), "289b7ec6", 4
        md5f3 d, a, b, c, xin(0), "e27fa", 11
        md5f3 c, d, a, b, xin(3), "d4ef3085", 16
        md5f3 b, c, d, a, xin(6), "04881d05", 23
        md5f3 a, b, c, d, xin(9), "d9d4d039", 4
        md5f3 d, a, b, c, xin(12), "e6db99e5", 11
        md5f3 c, d, a, b, xin(15), "1fa27cf8", 16
        md5f3 b, c, d, a, xin(2), "c4ac5665", 23
        ' round 4
        md5f4 a, b, c, d, xin(0), "f4292244", 6
        md5f4 d, a, b, c, xin(7), "432aff97", 10
        md5f4 c, d, a, b, xin(14), "ab9423a7", 15
        md5f4 b, c, d, a, xin(5), "fc93a039", 21
        md5f4 a, b, c, d, xin(12), "655b59c3", 6
        md5f4 d, a, b, c, xin(3), "8f0ccc92", 10
        md5f4 c, d, a, b, xin(10), "ffeff47d", 15
        md5f4 b, c, d, a, xin(1), "85845dd1", 21
        md5f4 a, b, c, d, xin(8), "6fa87e4f", 6
        md5f4 d, a, b, c, xin(15), "fe2ce6e0", 10
        md5f4 c, d, a, b, xin(6), "a3014314", 15
        md5f4 b, c, d, a, xin(13), "4e0811a1", 21
        md5f4 a, b, c, d, xin(4), "f7537e82", 6
        md5f4 d, a, b, c, xin(11), "bd3af235", 10
        md5f4 c, d, a, b, xin(2), "2ad7d2bb", 15
        md5f4 b, c, d, a, xin(9), "eb86d391", 21
        buf(0) = bigadd(buf(0), a)
        buf(1) = bigadd(buf(1), b)
        buf(2) = bigadd(buf(2), c)
        buf(3) = bigadd(buf(3), d)
    Next loopouter
    ' extract md5hash
    hashthis = ""
    For loopit = 0 To 3
        For loopinner = 3 To 0 Step -1
            hashthis = hashthis + Chr(Val("&h" + Mid$(buf(loopit), 1 + 2 * loopinner, 2)))
        Next loopinner
    Next loopit
    ' and return it
    md5_calc = hashthis
End Function
Function bigmod32add(ByVal value1 As String, ByVal value2 As String) As String
    bigmod32add = Right$(bigadd(value1, value2), 8)
End Function
Public Function bigadd(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
    tempnum = Len(value1) - Len(value2)
    If tempnum < 0 Then
        value1 = Space$(Abs(tempnum)) + value1
    ElseIf tempnum > 0 Then
        value2 = Space$(Abs(tempnum)) + value2
    End If
    tempnum = 0
    For loopit = Len(value1) To 1 Step -1
        tempnum = tempnum + Val("&h" + Mid$(value1, loopit, 1)) + Val("&h" + Mid$(value2, loopit, 1))
        valueans = Hex$(tempnum Mod 16) + valueans
        tempnum = Int(tempnum / 16)
    Next loopit
    If tempnum <> 0 Then
        valueans = Hex$(tempnum) + valueans
    End If
    bigadd = Right(valueans, 8)
End Function
Public Function rotleft(ByVal value1 As String, ByVal rots As Integer) As String
Dim tempstr As String
Dim loopit As Integer, loopinner As Integer
Dim tempnum As Integer
    rots = rots Mod 32
    
    If rots = 0 Then
        rotleft = value1
        Exit Function
    End If
    value1 = Right$(value1, 8)
    tempstr = String$(8 - Len(value1), "0") + value1
    value1 = ""
    ' convert to binary
    For loopit = 1 To 8
        tempnum = Val("&h" + Mid$(tempstr, loopit, 1))
        For loopinner = 3 To 0 Step -1
            If tempnum And 2 ^ loopinner Then
                value1 = value1 + "1"
            Else
                value1 = value1 + "0"
            End If
        Next loopinner
    Next loopit
    tempstr = Mid$(value1, rots + 1) + Left$(value1, rots)
    ' and convert back to hex
    value1 = ""
    For loopit = 0 To 7
        tempnum = 0
        For loopinner = 0 To 3
            If Val(Mid$(tempstr, 4 * loopit + loopinner + 1, 1)) Then
                tempnum = tempnum + 2 ^ (3 - loopinner)
            End If
        Next loopinner
        value1 = value1 + Hex$(tempnum)
    Next loopit
    rotleft = Right(value1, 8)
End Function
Function bigand(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
    tempnum = Len(value1) - Len(value2)
    If tempnum < 0 Then
        value2 = Mid$(value2, Abs(tempnum) + 1)
    ElseIf tempnum > 0 Then
        value1 = Mid$(value1, tempnum + 1)
    End If
    For loopit = 1 To Len(value1)
        valueans = valueans + Hex$(Val("&h" + Mid$(value1, loopit, 1)) And Val("&h" + Mid$(value2, loopit, 1)))
    Next loopit
    bigand = valueans
End Function
Function bignot(ByVal value1 As String) As String
Dim valueans As String
Dim loopit As Integer
    value1 = Right$(value1, 8)
    value1 = String$(8 - Len(value1), "0") + value1
    For loopit = 1 To 8
        valueans = valueans + Hex$(15 Xor Val("&h" + Mid$(value1, loopit, 1)))
    Next loopit
    bignot = valueans
End Function
Function bigor(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
    tempnum = Len(value1) - Len(value2)
    If tempnum < 0 Then
        valueans = Left$(value2, Abs(tempnum))
        value2 = Mid$(value2, Abs(tempnum) + 1)
    ElseIf tempnum > 0 Then
        valueans = Left$(value1, Abs(tempnum))
        value1 = Mid$(value1, tempnum + 1)
    End If
    For loopit = 1 To Len(value1)
        valueans = valueans + Hex$(Val("&h" + Mid$(value1, loopit, 1)) Or Val("&h" + Mid$(value2, loopit, 1)))
    Next loopit
    bigor = valueans
End Function
Function bigxor(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
    tempnum = Len(value1) - Len(value2)
    If tempnum < 0 Then
        valueans = Left$(value2, Abs(tempnum))
        value2 = Mid$(value2, Abs(tempnum) + 1)
    ElseIf tempnum > 0 Then
        valueans = Left$(value1, Abs(tempnum))
        value1 = Mid$(value1, tempnum + 1)
    End If
    For loopit = 1 To Len(value1)
        valueans = valueans + Hex$(Val("&h" + Mid$(value1, loopit, 1)) Xor Val("&h" + Mid$(value2, loopit, 1)))
    Next loopit
    bigxor = Right(valueans, 8)
End Function