当前位置:首页 > VB

在VB中实现MD5算法

canca19年前 (2007-06-21)VB649
——————————————————————————————————————
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, loopouter As Integer, loopinner As Integer
Dim a As String, b As String, c As String, d 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 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
                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), "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

        ' 第四轮循环
        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 + Chr(Val("&H" + 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$(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 = ""

    ' 转换成二进制形式
    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, 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
——————————————————————————————————————

扫描二维码推送至手机访问。

版权声明:本文由Ant.Master's Blog发布,如需转载请注明出处。

本文链接:https://iant.work/post/603.html

标签: VB
分享给朋友:

“在VB中实现MD5算法” 的相关文章

祝各位圣诞快乐

昨晚用VB弄的圣诞小礼物。呵呵...一时兴致到了... 下载:http://exs.mail.qq.com/cgi-bin/downloadfilepart?svrid=16&fid=2535de5c7dc3a850b2ad4e367a1c9e48ec2d9e8b55d811c1&f…

Browser Helper Objects

一、简介 有时,你可能需要一个定制版本的浏览器。在这种情况下,你可以自由地把一些新颖但又不标准的特征增加到一个浏览器上。结果,你最终有的只是一个新但不标准的浏览器。Web浏览器控件只是浏览器的分析引擎。...…

VB IE控制

VERSION 5.00Begin VB.UserControl uctlIe    ClientHeight    =   450   ClientLeft    &n…

VB使用VarType判断数据类型

在VB代码编写过程当中 有时候我们不熟悉一些函数或过程调用之后 返回的数据类型是什么 这个时候可以使用VarType(VarName)这个函数去测试变量的数据类型 返回值是一个整形数值 对应一下列别就可以知道变量的数据类型了 这样就...…

VB SendMessage 详解

首先我们了解一下Windows的消息机制。Windows是一个消息驱动式系统,Windows消息提供应用程序与应用程序之间,应用程序与Windows系统之间进行通信的手段。举个例子,打开记事本程序,该程序有一个 “文件“菜单。那么,在运行该…

VB获取WebBroswer里的验证码

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim X, CtrlRange Dim ii As Long ii = 0 For Each X In WebBrowser1.Docum…

发表评论

访客

◎欢迎参与讨论,请在这里发表您的看法和观点。