VB.NET实现的MD5加密算法示例【32位】

本文实例讲述了VB.NET实现的MD5加密算法。分享给大家供大家参考，具体如下：

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(ByRef 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 = BigOR(BigAND(X, y), BigAND(BigNOT(X), z))
    w = MD5F(tempstr, w, X, y, z, Xin, qdata, rots)
  End Sub
  Sub MD5F2(ByRef 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 = BigOR(BigAND(X, z), BigAND(y, BigNOT(z)))
    'tempstr = BigXOR(y, BigAND(z, BigXOR(X, y)))
    w = MD5F(tempstr, w, X, y, z, Xin, qdata, rots)
  End Sub
  Sub MD5F3(ByRef 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(BigXOR(X, y), z)
    'tempstr = BigXOR(X, BigXOR(y, z))
    w = MD5F(tempstr, w, X, y, z, Xin, qdata, rots)
  End Sub
  Sub MD5F4(ByRef 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
    Dim buf(4) As String
    Dim Xin(16) As String
    Dim tempnum As Integer, tempnum2 As Integer, loopit As Integer, loopouter As Integer, loopinner As Integer
    Dim a As String, b As String, c As String, d As String, tempstr99 As String
    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 tempnum2
      hashthis = hashthis + Chr(0)
    Next loopit
    For loopit = 1 To 8
      hashthis = hashthis + Chr(tempnum Mod 256)
      tempnum = tempnum - tempnum Mod 256
      tempnum = tempnum / 256
    Next loopit
    buf(0) = "67452301"
    buf(1) = "efcdab89"
    buf(2) = "98badcfe"
    buf(3) = "10325476"
    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
          'tempstr99 = Hex$(Asc(Mid$(hashthis, 64 * loopouter + 4 * loopit + loopinner, 1)))
          'If Len(tempstr99) < 2 Then tempstr99 = "0" + tempstr99
          'Xin(loopit) = Xin(loopit) + tempstr99
          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
      ' 第一轮循环
      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)
      ' 第二轮循环
      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)
      ' 第三轮循环
      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), "eaa127fa", 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)
      ' 第四轮循环
      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
    hashthis = ""
    For loopit = 0 To 3
      For loopinner = 3 To 0 Step -1
        hashthis = hashthis + Mid(buf(loopit), 1 + 2 * loopinner, 2)
      Next loopinner
    Next loopit
    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$(Math.Abs(tempnum)) + value1
    ElseIf tempnum > 0 Then
      value2 = Space$(Math.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
    For loopit = 1 To 8 - Len(value1)
      tempstr = tempstr + "0"
    Next loopit
    tempstr = tempstr + value1
    value1 = ""
    ' 转换成二进制形式
    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)
    ' 转换为十六进制
    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, Math.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
    Dim tempstr As String
    value1 = Right$(value1, 8)
    'value1 = String$(8 - Len(value1), "0") + value1
    For loopit = 1 To 8 - Len(value1)
      tempstr = tempstr + "0"
    Next loopit
    tempstr = tempstr + value1
    value1 = tempstr
    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, Math.Abs(tempnum))
      value2 = Mid$(value2, Math.Abs(tempnum) + 1)
    ElseIf tempnum > 0 Then
      valueans = Left$(value1, Math.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, Math.Abs(tempnum))
      value2 = Mid$(value2, Math.Abs(tempnum) + 1)
    ElseIf tempnum > 0 Then
      valueans = Left$(value1, Math.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

PS：关于加密解密感兴趣的朋友还可以参考本站在线工具：

MD5在线加密工具:
http://tools.jb51.net/password/CreateMD5Password

迅雷、快车、旋风URL加密/解密工具:
http://tools.jb51.net/password/urlrethunder

在线散列/哈希算法加密工具:
http://tools.jb51.net/password/hash_encrypt

在线MD5/hash/SHA-1/SHA-2/SHA-256/SHA-512/SHA-3/RIPEMD-160加密工具：
http://tools.jb51.net/password/hash_md5_sha

在线sha1/sha224/sha256/sha384/sha512加密工具：
http://tools.jb51.net/password/sha_encode

希望本文所述对大家VB.NET程序设计有所帮助。