Нашел такой вот полезный модуль. Ну, как полезный? Кому надо, тому полезный.
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 LongPrivate Declare Function CryptReleaseContext Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal dwFlags As Long) As LongPrivate 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 LongPrivate Declare Function CryptDestroyHash Lib "advapi32.dll" _
(ByVal hHash As Long) As LongPrivate Declare Function CryptHashData Lib "advapi32.dll" _
(ByVal hHash As Long, pbData As Any, _
ByVal cbData As Long, ByVal dwFlags As Long) As LongPrivate Declare Function CryptGetHashParam Lib "advapi32.dll" _
(ByVal hHash As Long, ByVal dwParam As Long, _
pbData As Any, ByRef pcbData As Long, _
ByVal dwFlags As Long) As LongPrivate Const PROV_RSA_FULL As Long = 1
Private Const PROV_RSA_AES As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000Private Const HP_HASHVAL As Long = 2
Private Const HP_HASHSIZE As Long = 4Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768Private Const ALG_SID_MD2 As Long = 1
Private Const ALG_SID_MD4 As Long = 2
Private Const ALG_SID_MD5 As Long = 3
Private Const ALG_SID_SHA As Long = 4
Private Const ALG_SID_SHA_256 As Long = 12
Private Const ALG_SID_SHA_384 As Long = 13
Private Const ALG_SID_SHA_512 As Long = 14Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)
'' Create Hash
Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As StringDim hProv As Long, hHash As Long
Dim strHash As String: strHash = ""If CryptAcquireContext(hProv, vbNullString, vbNullString, _
IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _
CRYPT_VERIFYCONTEXT) 0& ThenIf CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) 0& Then
Dim lngLength As Long
lngLength = UBound(abytData()) - LBound(abytData()) + 1Dim lngResult As Long
If lngLength > 0 Then
lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&)
Else
lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&)
End IfIf lngResult 0& Then
Dim abytHash(0 To 63) As Byte
lngLength = UBound(abytHash()) - LBound(abytHash()) + 1If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) 0& Then
Dim i As Long
For i = 0 To lngLength - 1strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2)
Next
End If
End If
CryptDestroyHash hHash
End If
CryptReleaseContext hProv, 0&
End IfCreateHash = LCase$(strHash)
End Function
' Create Hash From String(Shift_JIS)
Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String
CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID)
End Function' Create Hash From File
Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Long) As String
On Error Resume Next
Dim abytData() As Byte
Dim intFile As Integer
If Len(Dir(strFileName)) > 0 ThenintFile = FreeFile
Open strFileName For Binary Access Read Shared As #intFile
abytData() = InputB(LOF(intFile), #intFile)
Close #intFile
End IfDim lngError As Long
lngError = Err.NumberOn Error GoTo 0
CreateHashFile = IIf(lngError = 0, CreateHash(abytData(), lngAlgID), "")
End Function
Public Function CreateMD5Hash(abytData() As Byte) As String
CreateMD5Hash = CreateHash(abytData(), CALG_MD5)
End FunctionPublic Function CreateMD5HashString(ByVal strData As String) As String
CreateMD5HashString = CreateHashString(strData, CALG_MD5)
End FunctionPublic Function CreateMD5HashFile(ByVal strFileName As String) As String
CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5)
End Function
Public Function CreateSHA1Hash(abytData() As Byte) As String
CreateSHA1Hash = CreateHash(abytData(), CALG_SHA)
End FunctionPublic Function CreateSHA1HashString(ByVal strData As String) As String
CreateSHA1HashString = CreateHashString(strData, CALG_SHA)
End FunctionPublic Function CreateSHA1HashFile(ByVal strFileName As String) As String
CreateSHA1HashFile = CreateHashFile(strFileName, CALG_SHA)
End FunctionPublic Function CreateSHA256Hash(abytData() As Byte) As String
CreateSHA256Hash = CreateHash(abytData(), CALG_SHA_256)
End FunctionPublic Function CreateSHA256HashString(ByVal strData As String) As String
CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256)
End FunctionPublic Function CreateSHA256HashFile(ByVal strFileName As String) As String
CreateSHA256HashFile = CreateHashFile(strFileName, CALG_SHA_256)
End FunctionPublic Function CreateSHA384Hash(abytData() As Byte) As String
CreateSHA384Hash = CreateHash(abytData(), CALG_SHA_384)
End FunctionPublic Function CreateSHA384HashString(ByVal strData As String) As String
CreateSHA384HashString = CreateHashString(strData, CALG_SHA_384)
End FunctionPublic Function CreateSHA384HashFile(ByVal strFileName As String) As String
CreateSHA384HashFile = CreateHashFile(strFileName, CALG_SHA_384)
End FunctionPublic Function CreateSHA512Hash(abytData() As Byte) As String
CreateSHA512Hash = CreateHash(abytData(), CALG_SHA_512)
End FunctionPublic Function CreateSHA512HashString(ByVal strData As String) As String
CreateSHA512HashString = CreateHashString(strData, CALG_SHA_512)
End FunctionPublic Function CreateSHA512HashFile(ByVal strFileName As String) As String
CreateSHA512HashFile = CreateHashFile(strFileName, CALG_SHA_512)
End Function
Пример применения
Dim data As String, ipad(63) As Byte, data_hash As String
data_hash = CreateSHA1Hash(CStr(ipad) & StrConv(data, vbFromUnicode))