VB使用API进行MD5加密解密

根据网络资料整改,来源未知,已调试通过.

Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
    Alias "CryptAcquireContextA" ( _
    ByRef phProv As Long, _
    ByVal pszContainer As String, _
    ByVal pszProvider As String, _
    ByVal dwProvType As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
    ByVal hProv As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
    ByVal hProv As Long, _
    ByVal Algid As Long, _
    ByVal hKey As Long, _
    ByVal dwFlags As Long, _
    ByRef phHash As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
    ByVal hHash As Long) As Long

Private Declare Function CryptHashData Lib "advapi32.dll" ( _
    ByVal hHash As Long, _
    pbData As Any, _
    ByVal dwDataLen As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function CryptDeriveKey Lib "advapi32.dll" ( _
    ByVal hProv As Long, _
    ByVal Algid As Long, _
    ByVal hBaseData As Long, _
    ByVal dwFlags As Long, _
    ByRef phKey As Long) As Long

Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
    ByVal hKey As Long) As Long

Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
    ByVal hKey As Long, _
    ByVal hHash As Long, _
    ByVal Final As Long, _
    ByVal dwFlags As Long, _
    pbData As Any, _
    ByRef pdwDataLen As Long, _
    ByVal dwBufLen As Long) As Long

Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
    ByVal hKey As Long, _
    ByVal hHash As Long, _
    ByVal Final As Long, _
    ByVal dwFlags As Long, _
    pbData As Any, _
    ByRef pdwDataLen As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Dest As Any, _
    Src As Any, _
    ByVal Ln As Long)

Private Const PROV_RSA_FULL = 1

Private Const CRYPT_NEWKEYSET = &H8

Private Const ALG_CLASS_HASH = 32768
Private Const ALG_CLASS_DATA_ENCRYPT = 24576&

Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536&
Private Const ALG_TYPE_STREAM = 2048&

Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4

Private Const ALG_SID_DES = 1
Private Const ALG_SID_3DES = 3
Private Const ALG_SID_RC2 = 2
Private Const ALG_SID_RC4 = 1
Enum HASHALGORITHM
   MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
   MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
   MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
   SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum
Enum ENCALGORITHM
   DES = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_DES
   [3DES] = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_3DES
   RC2 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2
   RC4 = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4
End Enum

Dim HexMatrix(15, 15) As Byte
'================================================
'加密
'================================================
Public Function EncryptString(ByVal str As String, password As String) As String
    Dim byt() As Byte
    Dim HASHALGORITHM As HASHALGORITHM
    Dim ENCALGORITHM As ENCALGORITHM
    byt = str
    HASHALGORITHM = MD5
    ENCALGORITHM = RC4
    EncryptString = BytesToHex(Encrypt(byt, password, HASHALGORITHM, ENCALGORITHM))
End Function
Public Function EncryptByte(byt() As Byte, password As String) As Byte()
    Dim HASHALGORITHM As HASHALGORITHM
    Dim ENCALGORITHM As ENCALGORITHM
    HASHALGORITHM = MD5
    ENCALGORITHM = RC4
    EncryptByte = Encrypt(byt, password, HASHALGORITHM, ENCALGORITHM)
End Function
Private Function Encrypt(data() As Byte, ByVal password As String, Optional ByVal HASHALGORITHM As HASHALGORITHM = MD5, Optional ByVal ENCALGORITHM As ENCALGORITHM = RC4) As Byte()
    Dim lRes As Long
    Dim hProv As Long
    Dim hHash As Long
    Dim hKey As Long
    Dim lBufLen As Long
    Dim lDataLen As Long
    Dim abData() As Byte
    lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, 0)
    If lRes = 0 And Err.LastDllError = &H80090016 Then lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
    If lRes <> 0 Then
        lRes = CryptCreateHash(hProv, HASHALGORITHM, 0, 0, hHash)
        If lRes <> 0 Then
            lRes = CryptHashData(hHash, ByVal password, Len(password), 0)
            If lRes <> 0 Then
                lRes = CryptDeriveKey(hProv, ENCALGORITHM, hHash, 0, hKey)
                If lRes <> 0 Then
                    lBufLen = UBound(data) - LBound(data) + 1
                    lDataLen = lBufLen
                    lRes = CryptEncrypt(hKey, 0&, 1, 0, ByVal 0&, lBufLen, 0)
                    If lRes <> 0 Then
                        If lBufLen < lDataLen Then lBufLen = lDataLen
                        ReDim abData(0 To lBufLen - 1)
                        MoveMemory abData(0), data(LBound(data)), lDataLen
                        lRes = CryptEncrypt(hKey, 0&, 1, 0, abData(0), lBufLen, lDataLen)
                        If lRes <> 0 Then
                            If lDataLen <> lBufLen Then ReDim Preserve abData(0 To lBufLen - 1)
                            Encrypt = abData
                        End If
                    End If
                End If
                CryptDestroyKey hKey
            End If
            CryptDestroyHash hHash
        End If
        CryptReleaseContext hProv, 0
    End If
    If lRes = 0 Then Err.Raise Err.LastDllError
 End Function
'================================================
'解密
'================================================
Public Function DecryptString(ByVal str As String, password As String) As String
    Dim byt() As Byte
    Dim HASHALGORITHM As HASHALGORITHM
    Dim ENCALGORITHM As ENCALGORITHM
    byt = HexToBytes(str)
    HASHALGORITHM = MD5
    ENCALGORITHM = RC4
    DecryptString = Decrypt(byt, password, HASHALGORITHM, ENCALGORITHM)
End Function
Public Function DecryptByte(byt() As Byte, password As String) As Byte()
    Dim HASHALGORITHM As HASHALGORITHM
    Dim ENCALGORITHM As ENCALGORITHM
    HASHALGORITHM = MD5
    ENCALGORITHM = RC4
    DecryptByte = Decrypt(byt, password, HASHALGORITHM, ENCALGORITHM)
End Function
Private Function Decrypt(data() As Byte, ByVal password As String, Optional ByVal HASHALGORITHM As HASHALGORITHM = MD5, Optional ByVal ENCALGORITHM As ENCALGORITHM = RC4) As Byte()
    Dim lRes As Long
    Dim hProv As Long
    Dim hHash As Long
    Dim hKey As Long
    Dim lBufLen As Long
    Dim abData() As Byte
    lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, 0)
    If lRes = 0 And Err.LastDllError = &H80090016 Then lRes = CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
    If lRes <> 0 Then
        lRes = CryptCreateHash(hProv, HASHALGORITHM, 0, 0, hHash)
        If lRes <> 0 Then
            lRes = CryptHashData(hHash, ByVal password, Len(password), 0)
            If lRes <> 0 Then
                lRes = CryptDeriveKey(hProv, ENCALGORITHM, hHash, 0, hKey)
                If lRes <> 0 Then
                    lBufLen = UBound(data) - LBound(data) + 1
                    ReDim abData(0 To lBufLen - 1)
                    MoveMemory abData(0), data(LBound(data)), lBufLen
                    lRes = CryptDecrypt(hKey, 0&, 1, 0, abData(0), lBufLen)
                    If lRes <> 0 Then
                        ReDim Preserve abData(0 To lBufLen - 1)
                        Decrypt = abData
                    End If
                End If
                CryptDestroyKey hKey
            End If
            CryptDestroyHash hHash
        End If
        CryptReleaseContext hProv, 0
    End If
    If lRes = 0 Then Err.Raise Err.LastDllError
End Function

'================================================
'字节与十六进制字符串的转换
'================================================
Public Function BytesToHex(bits() As Byte) As String
    Dim i As Long
    Dim b
    Dim s As String
    For Each b In bits
        If b < 16 Then
            s = s & "0" & Hex(b)
        Else
            s = s & Hex(b)
        End If
    Next
    BytesToHex = s
End Function
Public Function HexToBytes(sHex As String) As Byte()
    Dim b() As Byte
    Dim rst() As Byte
    Dim i As Long
    Dim n As Long
    Dim m1 As Byte
    Dim m2 As Byte
    If HexMatrix(15, 15) = 0 Then Call MatrixInitialize
    b = StrConv(sHex, vbFromUnicode)
    i = (UBound(b) + 1) / 2 - 1
    ReDim rst(i)
    For i = 0 To UBound(b) Step 2
        If b(i) > 96 Then
            m1 = b(i) - 87
        ElseIf b(i) > 64 Then
            m1 = b(i) - 55
        ElseIf b(i) > 47 Then
            m1 = b(i) - 48
        End If
        If b(i + 1) > 96 Then
            m2 = b(i + 1) - 87
        ElseIf b(i + 1) > 64 Then
            m2 = b(i + 1) - 55
        ElseIf b(i + 1) > 47 Then
            m2 = b(i + 1) - 48
        End If
        rst(n) = HexMatrix(m1, m2)
        n = n + 1
    Next i
    HexToBytes = rst
End Function
Private Sub MatrixInitialize()
    HexMatrix(0, 0) = &H0:    HexMatrix(0, 1) = &H1:    HexMatrix(0, 2) = &H2:    HexMatrix(0, 3) = &H3:    HexMatrix(0, 4) = &H4:    HexMatrix(0, 5) = &H5:    HexMatrix(0, 6) = &H6:    HexMatrix(0, 7) = &H7
    HexMatrix(0, 8) = &H8:    HexMatrix(0, 9) = &H9:    HexMatrix(0, 10) = &HA:   HexMatrix(0, 11) = &HB:   HexMatrix(0, 12) = &HC:   HexMatrix(0, 13) = &HD:   HexMatrix(0, 14) = &HE:   HexMatrix(0, 15) = &HF
    HexMatrix(1, 0) = &H10:   HexMatrix(1, 1) = &H11:   HexMatrix(1, 2) = &H12:   HexMatrix(1, 3) = &H13:   HexMatrix(1, 4) = &H14:   HexMatrix(1, 5) = &H15:   HexMatrix(1, 6) = &H16:   HexMatrix(1, 7) = &H17
    HexMatrix(1, 8) = &H18:   HexMatrix(1, 9) = &H19:   HexMatrix(1, 10) = &H1A:  HexMatrix(1, 11) = &H1B:  HexMatrix(1, 12) = &H1C:  HexMatrix(1, 13) = &H1D:  HexMatrix(1, 14) = &H1E:  HexMatrix(1, 15) = &H1F
    HexMatrix(2, 0) = &H20:   HexMatrix(2, 1) = &H21:   HexMatrix(2, 2) = &H22:   HexMatrix(2, 3) = &H23:   HexMatrix(2, 4) = &H24:   HexMatrix(2, 5) = &H25:   HexMatrix(2, 6) = &H26:   HexMatrix(2, 7) = &H27
    HexMatrix(2, 8) = &H28:   HexMatrix(2, 9) = &H29:   HexMatrix(2, 10) = &H2A:  HexMatrix(2, 11) = &H2B:  HexMatrix(2, 12) = &H2C:  HexMatrix(2, 13) = &H2D:  HexMatrix(2, 14) = &H2E:  HexMatrix(2, 15) = &H2F
    HexMatrix(3, 0) = &H30:   HexMatrix(3, 1) = &H31:   HexMatrix(3, 2) = &H32:   HexMatrix(3, 3) = &H33:   HexMatrix(3, 4) = &H34:   HexMatrix(3, 5) = &H35:   HexMatrix(3, 6) = &H36:   HexMatrix(3, 7) = &H37
    HexMatrix(3, 8) = &H38:   HexMatrix(3, 9) = &H39:   HexMatrix(3, 10) = &H3A:  HexMatrix(3, 11) = &H3B:  HexMatrix(3, 12) = &H3C:  HexMatrix(3, 13) = &H3D:  HexMatrix(3, 14) = &H3E:  HexMatrix(3, 15) = &H3F
    HexMatrix(4, 0) = &H40:   HexMatrix(4, 1) = &H41:   HexMatrix(4, 2) = &H42:   HexMatrix(4, 3) = &H43:   HexMatrix(4, 4) = &H44:   HexMatrix(4, 5) = &H45:   HexMatrix(4, 6) = &H46:   HexMatrix(4, 7) = &H47
    HexMatrix(4, 8) = &H48:   HexMatrix(4, 9) = &H49:   HexMatrix(4, 10) = &H4A:  HexMatrix(4, 11) = &H4B:  HexMatrix(4, 12) = &H4C:  HexMatrix(4, 13) = &H4D:  HexMatrix(4, 14) = &H4E:  HexMatrix(4, 15) = &H4F
    HexMatrix(5, 0) = &H50:   HexMatrix(5, 1) = &H51:   HexMatrix(5, 2) = &H52:   HexMatrix(5, 3) = &H53:   HexMatrix(5, 4) = &H54:   HexMatrix(5, 5) = &H55:   HexMatrix(5, 6) = &H56:   HexMatrix(5, 7) = &H57
    HexMatrix(5, 8) = &H58:   HexMatrix(5, 9) = &H59:   HexMatrix(5, 10) = &H5A:  HexMatrix(5, 11) = &H5B:  HexMatrix(5, 12) = &H5C:  HexMatrix(5, 13) = &H5D:  HexMatrix(5, 14) = &H5E:  HexMatrix(5, 15) = &H5F
    HexMatrix(6, 0) = &H60:   HexMatrix(6, 1) = &H61:   HexMatrix(6, 2) = &H62:   HexMatrix(6, 3) = &H63:   HexMatrix(6, 4) = &H64:   HexMatrix(6, 5) = &H65:   HexMatrix(6, 6) = &H66:   HexMatrix(6, 7) = &H67
    HexMatrix(6, 8) = &H68:   HexMatrix(6, 9) = &H69:   HexMatrix(6, 10) = &H6A:  HexMatrix(6, 11) = &H6B:  HexMatrix(6, 12) = &H6C:  HexMatrix(6, 13) = &H6D:  HexMatrix(6, 14) = &H6E:  HexMatrix(6, 15) = &H6F
    HexMatrix(7, 0) = &H70:   HexMatrix(7, 1) = &H71:   HexMatrix(7, 2) = &H72:   HexMatrix(7, 3) = &H73:   HexMatrix(7, 4) = &H74:   HexMatrix(7, 5) = &H75:   HexMatrix(7, 6) = &H76:   HexMatrix(7, 7) = &H77
    HexMatrix(7, 8) = &H78:   HexMatrix(7, 9) = &H79:   HexMatrix(7, 10) = &H7A:  HexMatrix(7, 11) = &H7B:  HexMatrix(7, 12) = &H7C:  HexMatrix(7, 13) = &H7D:  HexMatrix(7, 14) = &H7E:  HexMatrix(7, 15) = &H7F
    HexMatrix(8, 0) = &H80:   HexMatrix(8, 1) = &H81:   HexMatrix(8, 2) = &H82:   HexMatrix(8, 3) = &H83:   HexMatrix(8, 4) = &H84:   HexMatrix(8, 5) = &H85:   HexMatrix(8, 6) = &H86:   HexMatrix(8, 7) = &H87
    HexMatrix(8, 8) = &H88:   HexMatrix(8, 9) = &H89:   HexMatrix(8, 10) = &H8A:  HexMatrix(8, 11) = &H8B:  HexMatrix(8, 12) = &H8C:  HexMatrix(8, 13) = &H8D:  HexMatrix(8, 14) = &H8E:  HexMatrix(8, 15) = &H8F
    HexMatrix(9, 0) = &H90:   HexMatrix(9, 1) = &H91:   HexMatrix(9, 2) = &H92:   HexMatrix(9, 3) = &H93:   HexMatrix(9, 4) = &H94:   HexMatrix(9, 5) = &H95:   HexMatrix(9, 6) = &H96:   HexMatrix(9, 7) = &H97
    HexMatrix(9, 8) = &H98:   HexMatrix(9, 9) = &H99:   HexMatrix(9, 10) = &H9A:  HexMatrix(9, 11) = &H9B:  HexMatrix(9, 12) = &H9C:  HexMatrix(9, 13) = &H9D:  HexMatrix(9, 14) = &H9E:  HexMatrix(9, 15) = &H9F
    HexMatrix(10, 0) = &HA0:  HexMatrix(10, 1) = &HA1:  HexMatrix(10, 2) = &HA2:  HexMatrix(10, 3) = &HA3:  HexMatrix(10, 4) = &HA4:  HexMatrix(10, 5) = &HA5:  HexMatrix(10, 6) = &HA6:  HexMatrix(10, 7) = &HA7
    HexMatrix(10, 8) = &HA8:  HexMatrix(10, 9) = &HA9:  HexMatrix(10, 10) = &HAA: HexMatrix(10, 11) = &HAB: HexMatrix(10, 12) = &HAC: HexMatrix(10, 13) = &HAD: HexMatrix(10, 14) = &HAE: HexMatrix(10, 15) = &HAF
    HexMatrix(11, 0) = &HB0:  HexMatrix(11, 1) = &HB1:  HexMatrix(11, 2) = &HB2:  HexMatrix(11, 3) = &HB3:  HexMatrix(11, 4) = &HB4:  HexMatrix(11, 5) = &HB5:  HexMatrix(11, 6) = &HB6:  HexMatrix(11, 7) = &HB7
    HexMatrix(11, 8) = &HB8:  HexMatrix(11, 9) = &HB9:  HexMatrix(11, 10) = &HBA: HexMatrix(11, 11) = &HBB: HexMatrix(11, 12) = &HBC: HexMatrix(11, 13) = &HBD: HexMatrix(11, 14) = &HBE: HexMatrix(11, 15) = &HBF
    HexMatrix(12, 0) = &HC0:  HexMatrix(12, 1) = &HC1:  HexMatrix(12, 2) = &HC2:  HexMatrix(12, 3) = &HC3:  HexMatrix(12, 4) = &HC4:  HexMatrix(12, 5) = &HC5:  HexMatrix(12, 6) = &HC6:  HexMatrix(12, 7) = &HC7
    HexMatrix(12, 8) = &HC8:  HexMatrix(12, 9) = &HC9:  HexMatrix(12, 10) = &HCA: HexMatrix(12, 11) = &HCB: HexMatrix(12, 12) = &HCC: HexMatrix(12, 13) = &HCD: HexMatrix(12, 14) = &HCE: HexMatrix(12, 15) = &HCF
    HexMatrix(13, 0) = &HD0:  HexMatrix(13, 1) = &HD1:  HexMatrix(13, 2) = &HD2:  HexMatrix(13, 3) = &HD3:  HexMatrix(13, 4) = &HD4:  HexMatrix(13, 5) = &HD5:  HexMatrix(13, 6) = &HD6:  HexMatrix(13, 7) = &HD7
    HexMatrix(13, 8) = &HD8:  HexMatrix(13, 9) = &HD9:  HexMatrix(13, 10) = &HDA: HexMatrix(13, 11) = &HDB: HexMatrix(13, 12) = &HDC: HexMatrix(13, 13) = &HDD: HexMatrix(13, 14) = &HDE: HexMatrix(13, 15) = &HDF
    HexMatrix(14, 0) = &HE0:  HexMatrix(14, 1) = &HE1:  HexMatrix(14, 2) = &HE2:  HexMatrix(14, 3) = &HE3:  HexMatrix(14, 4) = &HE4:  HexMatrix(14, 5) = &HE5:  HexMatrix(14, 6) = &HE6:  HexMatrix(14, 7) = &HE7
    HexMatrix(14, 8) = &HE8:  HexMatrix(14, 9) = &HE9:  HexMatrix(14, 10) = &HEA: HexMatrix(14, 11) = &HEB: HexMatrix(14, 12) = &HEC: HexMatrix(14, 13) = &HED: HexMatrix(14, 14) = &HEE: HexMatrix(14, 15) = &HEF
    HexMatrix(15, 0) = &HF0:  HexMatrix(15, 1) = &HF1:  HexMatrix(15, 2) = &HF2:  HexMatrix(15, 3) = &HF3:  HexMatrix(15, 4) = &HF4:  HexMatrix(15, 5) = &HF5:  HexMatrix(15, 6) = &HF6:  HexMatrix(15, 7) = &HF7
    HexMatrix(15, 8) = &HF8:  HexMatrix(15, 9) = &HF9:  HexMatrix(15, 10) = &HFA: HexMatrix(15, 11) = &HFB: HexMatrix(15, 12) = &HFC: HexMatrix(15, 13) = &HFD: HexMatrix(15, 14) = &HFE: HexMatrix(15, 15) = &HFF
End Sub

测试代码:

 

Private Sub Command1_Click()
    Dim bs() As Byte, be() As Byte, bd() As Byte
    bs = StrConv("0123456789", vbFromUnicode)
    be = EncryptByte(bs, "password")
    bd = DecryptByte(be, "password")
    Dim s1 As String, s2 As String, s3 As String
    s1 = BytesToHex(bs)
    s2 = BytesToHex(be)
    s3 = BytesToHex(bd)
    Print "原始字节:" & s1 & " (len:" & Len(s1) / 2 & ")"
    Print "加密字节:" & s2 & " (len:" & Len(s2) & ")"
    Print "解密字节:" & s3 & " (len:" & Len(s3) & ")"
    Print "--------------------------------"
    Dim ss As String, se As String, sd As String
    ss = "MD5加/解密"
    se = EncryptString(ss, "password")
    sd = DecryptString(se, "password")
    Print "原文:" & ss & " (len:" & LenB(ss) & ")"
    Print "加密:" & se & " (len:" & Len(se) & ")"
    Print "解密:" & sd & " (len:" & LenB(sd) & ")"
End Sub

转载于:https://www.cnblogs.com/youyouran/p/5381050.html

'部分代码如下 Public Function MD5(sMessage) m_lOnBits(0) = CLng(1) m_lOnBits(1) = CLng(3) m_lOnBits(2) = CLng(7) m_lOnBits(3) = CLng(15) m_lOnBits(4) = CLng(31) m_lOnBits(5) = CLng(63) m_lOnBits(6) = CLng(127) m_lOnBits(7) = CLng(255) m_lOnBits(8) = CLng(511) m_lOnBits(9) = CLng(1023) m_lOnBits(10) = CLng(2047) m_lOnBits(11) = CLng(4095) m_lOnBits(12) = CLng(8191) m_lOnBits(13) = CLng(16383) m_lOnBits(14) = CLng(32767) m_lOnBits(15) = CLng(65535) m_lOnBits(16) = CLng(131071) m_lOnBits(17) = CLng(262143) m_lOnBits(18) = CLng(524287) m_lOnBits(19) = CLng(1048575) m_lOnBits(20) = CLng(2097151) m_lOnBits(21) = CLng(4194303) m_lOnBits(22) = CLng(8388607) m_lOnBits(23) = CLng(16777215) m_lOnBits(24) = CLng(33554431) m_lOnBits(25) = CLng(67108863) m_lOnBits(26) = CLng(134217727) m_lOnBits(27) = CLng(268435455) m_lOnBits(28) = CLng(536870911) m_lOnBits(29) = CLng(1073741823) m_lOnBits(30) = CLng(2147483647) m_l2Power(0) = CLng(1) m_l2Power(1) = CLng(2) m_l2Power(2) = CLng(4) m_l2Power(3) = CLng(8) m_l2Power(4) = CLng(16) m_l2Power(5) = CLng(32) m_l2Power(6) = CLng(64) m_l2Power(7) = CLng(128) m_l2Power(8) = CLng(256) m_l2Power(9) = CLng(512) m_l2Power(10) = CLng(1024) m_l2Power(11) = CLng(2048) m_l2Power(12) = CLng(4096) m_l2Power(13) = CLng(8192) m_l2Power(14) = CLng(16384) m_l2Power(15) = CLng(32768) m_l2Power(16) = CLng(65536) m_l2Power(17) = CLng(131072) m_l2Power(18) = CLng(262144) m_l2Power(19) = CLng(524288) m_l2Power(20) = CLng(1048576) m_l2Power(21) = CLng(2097152) m_l2Power(22) = CLng(4194304) m_l2Power(23) = CLng(8388608) m_l2Power(24) = CLng(16777216) m_l2Power(25) = CLng(33554432) m_l2Power(26) = CLng(67108864) m_l2Power(27) = CLng(134217728) m_l2Power(28) = CLng(268435456) m_l2Power(29) = CLng(536870912) m_l2Power(30) = CLng(1073741824) Dim x Dim k Dim AA Dim BB Dim CC Dim DD Dim a Dim b Dim c Dim d Const S11 = 7 Const S12 = 12 Const S13 = 17 Const S14 = 22 Const S21 = 5 Const S22 = 9 Const S23 = 14 Const S24 = 20 Const S31 = 4 Const S32 = 11 Const S33 = 16 Const S34 = 23 Const S41 = 6 Const S42 = 10 Const S43 = 15 Const S44 = 21 x = ConvertToWordArray(sMessage) a = &H67452301; b = &HEFCDAB89; c = &H98BADCFE; d = &H10325476; For k = 0 To UBound(x) Step 16 AA = a BB = b CC = c DD = d md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478; md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756; md5_FF c, d, a, b, x(k + 2), S13, &H242070DB; md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE; md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF; md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A; md5_FF c, d, a, b, x(k + 6), S13, &HA8304613; md5_FF b, c, d, a, x(k + 7), S14, &HFD469501; md5_FF a, b, c, d, x(k + 8), S11, &H698098D8; md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF; md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1; md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE; md5_FF a, b, c, d, x(k + 12), S11, &H6B901122; md5_FF d, a, b, c, x(k + 13), S12, &HFD987193; md5_FF c, d, a, b, x(k + 14), S13, &HA679438E; md5_FF b, c, d, a, x(k + 15), S14, &H49B40821; md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562; md5_GG d, a, b, c, x(k + 6), S22, &HC040B340; md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51; md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA; md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D; md5_GG d, a, b, c, x(k + 10), S22, &H2441453; md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681; md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8; md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6; md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6; md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87; md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED; md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905; md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8; md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9; md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A; md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942; md5_HH d, a, b, c, x(k + 8), S32, &H8771F681; md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122; md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C; md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44; md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9; md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60; md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70; md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6; md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA; md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085; md5_HH b, c, d, a, x(k + 6), S34, &H4881D05; md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039; md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5; md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8; md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665; md5_II a, b, c, d, x(k + 0), S41, &HF4292244; md5_II d, a, b, c, x(k + 7), S42, &H432AFF97; md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7; md5_II b, c, d, a, x(k + 5), S44, &HFC93A039; md5_II a, b, c, d, x(k + 12), S41, &H655B59C3; md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92; md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D; md5_II b, c, d, a, x(k + 1), S44, &H85845DD1; md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F; md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0; md5_II c, d, a, b, x(k + 6), S43, &HA3014314; md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1; md5_II a, b, c, d, x(k + 4), S41, &HF7537E82; md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235; md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB; md5_II b, c, d, a, x(k + 9), S44, &HEB86D391; a = AddUnsigned(a, AA) b = AddUnsigned(b, BB) c = AddUnsigned(c, CC) d = AddUnsigned(d, DD) Next MD5_32 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) '32位MD5 MD5_16 = LCase(WordToHex(b) & WordToHex(c)) '16位MD5 End Function
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值