添加 MD5.vba

MD5.vba

@@ -0,0 +1,47 @@
+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 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 CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
+Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
+Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
+Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
+
+Private Const PROV_RSA_FULL As Long = 1
+Private Const ALG_CLASS_HASH As Long = 4 * 2 ^ 13
+Private Const ALG_TYPE_ANY As Long = 0
+Private Const ALG_SID_MD5 As Long = 3
+Private Const ALGID_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
+Private Const HP_HASHVAL As Long = 2
+
+Public Function MD5(ByVal s As String) As String
+    Dim hProv As Long
+    Dim hHash As Long
+    Dim b() As Byte
+    Dim l As Long
+    Dim i As Long
+
+    If CryptAcquireContext(hProv, vbNullString, vbNullString, PROV_RSA_FULL, 0) = 0 Then
+        Err.Raise Err.LastDllError, , "CryptAcquireContext failed"
+    End If
+
+    If CryptCreateHash(hProv, ALGID_MD5, 0, 0, hHash) = 0 Then
+        Err.Raise Err.LastDllError, , "CryptCreateHash failed"
+    End If
+
+    If CryptHashData(hHash, s, Len(s), 0) = 0 Then
+        Err.Raise Err.LastDllError, , "CryptHashData failed"
+    End If
+
+    l = 16
+    ReDim b(0 To l - 1)
+    If CryptGetHashParam(hHash, HP_HASHVAL, b(0), l, 0) = 0 Then
+        Err.Raise Err.LastDllError, , "CryptGetHashParam failed"
+    End If
+
+    MD5 = ""
+    For i = 0 To l - 1
+        MD5 = MD5 & Right$("0" & Hex(b(i)), 2)
+    Next
+
+    CryptDestroyHash hHash
+    CryptReleaseContext hProv, 0
+End Function