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 S 
tring, ByVal y As String, ByVal z As String, ByVal Xin As String, ByVa 
l qdata As String, ByVal rots As Integer) 
    MD5F = BigMod32Add(RotLeft(BigMod32Add(BigMod32Add(w, tempstr), Bi 
gMod32Add(Xin, qdata)), rots), X) 
End Function 

Sub MD5F1(w As String, ByVal X As String, ByVal y As String, ByVal z A 
s String, ByVal Xin As String, ByVal qdata As String, ByVal rots As In 
teger) 
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 A 
s String, ByVal Xin As String, ByVal qdata As String, ByVal rots As In 
teger) 
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 A 
s String, ByVal Xin As String, ByVal qdata As String, ByVal rots As In 
teger) 
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 A 
s String, ByVal Xin As String, ByVal qdata As String, ByVal rots As In 
teger) 
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) A 
s 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 Str 
ing 
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, loop 
it, 1))) 
    Next loopit 

    BigNOT = valueans 
End Function 

Function BigOR(ByVal value1 As String, ByVal value2 As String) As Stri 
ng 
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 Str 
ing 
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