48 lines
2.1 KiB
QBasic
48 lines
2.1 KiB
QBasic
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
|