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
|