Причем, что интересно:
при выполнении функции CryptGetHashParam с параметром HP_HASHSIZE получаем в параметре pdwDataLen значение 4,
а при выполнении этой функции с параметром HP_HASHVAL получаем в параметре pdwDataLen значение 16
- Код: Выделить всё
Private Const HP_HASHSIZE = &H4
'The hash value or message hash for the hash object specified by hHash. This value is generated based on the data supplied to the hash object earlier through the CryptHashData
Private Const HP_HASHVAL = &H2
'
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, pbData As Any, _
ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
'
Public 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
Public Function GetStringHashValue(strDATA As String, HashValue() As Byte) As Boolean
Dim blnResult As Boolean
Const ERR_SOURCE As String = "U-Soft.HashModule.GetHashValue"
Dim lngProvider As Long, lngHash As Long
Dim lngDataLength As Long
' Aquire context to the microsoft default CSP
blnResult = CBool(CryptAcquireContext(lngProvider, vbNullString, _
MS_DEFAULT_PROVIDER, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT))
If Not blnResult Then
Err.Raise vbObjectError + 1, _
ERR_SOURCE, _
ERROR_AQUIRING_CONTEXT
Exit Function
End If
blnResult = CBool(CryptCreateHash(lngProvider, CALG_MD5, 0, 0, lngHash))
If Not blnResult Then
Err.Raise vbObjectError + 2, ERR_SOURCE, ERROR_CREATING_HASH
Exit Function
End If
lngDataLength = Len(strDATA)
blnResult = CBool(CryptHashData(lngHash, ByVal strDATA, lngDataLength, 0))
If Not blnResult Then
Err.Raise vbObjectError + 3, ERR_SOURCE, ERROR_CREATING_HASH_DATA
Exit Function
End If
lngDataLength = 0
blnResult = CBool(CryptGetHashParam(lngHash, HP_HASHSIZE, ByVal 0&, lngDataLength, 0&))
If Not blnResult Then
Err.Raise vbObjectError + 4, ERR_SOURCE, ERROR_GETTING_RESULTS + " (HP_HASHSIZE)"
Exit Function
End If
ReDim HashValue(0 To lngDataLength - 1)
blnResult = CBool(CryptGetHashParam(lngHash, HP_HASHVAL, ByVal HashValue(0), lngDataLength, 0&))
If Not blnResult Then
Err.Raise vbObjectError + 4, ERR_SOURCE, ERROR_GETTING_RESULTS + " (HP_HASHVAL)"
Exit Function
End If
Call CryptDestroyHash(lngHash)
Call CryptReleaseContext(lngHash, 0)
GetStringHashValue = blnResult 'left$(strDATA, lngDataLength)
End Function
