经典加密算法在VB中的实现（2）-MD5

 

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), "8f0clearcase/" target="_blank" >ccc92", 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

经典加密算法在VB中的实现（3）- RC4

经典加密算法在VB中的实现（4）- DES

经典加密算法在VB中的实现（1）- Base64

原文转自：http://www.ltesting.net