rabix
/
snippets
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

添加 MD5-64.bas

This commit is contained in:
rabix 2024-03-27 20:43:09 +08:00
parent 7b9227efcd
commit 8f3030dbe2
1 changed files with 47 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
MD5-64.bas Normal file
View File

@ -0,0 +1,47 @@
Private Declare PtrSafe Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As LongPtr, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As LongPtr, ByVal Algid As Long, ByVal hKey As LongPtr, ByVal dwFlags As Long, ByRef phHash As LongPtr) As Long
Private Declare PtrSafe Function CryptHashData Lib "advapi32.dll" (ByVal hHash As LongPtr, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As LongPtr, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As LongPtr) As Long
Private Declare PtrSafe Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As LongPtr, 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 LongPtr
Dim hHash As LongPtr
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