HashString
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 CryptReleaseContext Lib "advapi32.dll" ( _ ByVal hProv 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 CryptDestroyHash Lib "advapi32.dll" ( _ ByVal hHash 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 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 Const PROV_RSA_FULL = 1 Private Const ALG_CLASS_HASH = 32768 Private Const ALG_TYPE_ANY = 0 Private Const ALG_SID_MD2 = 1 Private Const ALG_SID_MD4 = 2 Private Const ALG_SID_MD5 = 3 Private Const ALG_SID_SHA1 = 4 Enum HashAlgorithm MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2 MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4 MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5 SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1 End Enum Private Const HP_HASHVAL = 2 Private Const HP_HASHSIZE = 4 Function HashString( _ ByVal Str As String, _ Optional ByVal Algorithm As HashAlgorithm = MD5) As String Dim hCtx As Long Dim hHash As Long Dim lRes As Long Dim lLen As Long Dim lIdx As Long Dim abData() As Byte ' Get default provider context handle lRes = CryptAcquireContext(hCtx, vbNullString, _ vbNullString, PROV_RSA_FULL, 0) If lRes <> 0 Then ' Create the hash lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash) If lRes <> 0 Then ' Hash the string lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0) If lRes <> 0 Then ' Get the hash lenght lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0) If lRes <> 0 Then ' Initialize the buffer ReDim abData(0 To lLen - 1) ' Get the hash value lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0) If lRes <> 0 Then ' Convert value to hex string For lIdx = 0 To UBound(abData) HashString = HashString & _ Right$("0" & Hex$(abData(lIdx)), 2) Next End If End If End If ' Release the hash handle CryptDestroyHash hHash End If End If ' Release the provider context CryptReleaseContext hCtx, 0 ' Raise an error if lRes = 0 If lRes = 0 Then Err.Raise Err.LastDllError End Function