'contexte RSA signature
Private Const PROV_RSA_FULL As Long = 1&
Private Const CALG_MD5 As Long = &H8003&
'initialise un contexte de cryptage
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
'crée un hash
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
'ajoute des données au hash
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As Long, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
'termine le hash
Private Const HP_HASHVAL As Long = &H2
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pByte As Long, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptSignHash Lib "advapi32.dll" Alias "CryptSignHashA" (ByVal hHash As Long, ByVal dwKeySpec As Long, ByVal sDescription As Long, ByVal dwFlags As Long, ByVal pbSignature As Long, ByRef pdwSigLen As Long) As Long
'libère les ressources associées au hash
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
'libère le contexte de cryptage
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
'calcule le hash (en hexa ascii) des données pointées par pbData
'===============================================================
'pbData : pointeur vers les données à hasher
'dwDataLen : taille des données à hasher
Private Function GetHashString(ByVal AlgID As Long, ByVal pbData As Long, ByVal dwDataLen As Long) As String
'buffer pour les données du hash
Dim buff() As Byte, dwSigLen As Long, i As Long
'calcule le hash
dwSigLen = GetHashBin(AlgID, pbData, dwDataLen, buff)
'convertit le hash en représentation ASCII
GetHashString = vbNullString
For i = 0 To dwSigLen - 1
GetHashString = GetHashString & Right("00" & Hex$(buff(i)), 2)
Next
End Function
'calcule le hash (en hexa) des données pointées par pbData
'===============================================================
'AlgID : algorithme de hash à utiliser
'pbData : pointeur vers les données à hasher
'dwDataLen : taille des données à hasher
'OUT buff : contient le hash binaire au retour
Private Function GetHashBin(ByVal AlgID As Long, ByVal pbData As Long, ByVal dwDataLen As Long, outBuff() As Byte) As Long
Dim hProv As Long, hHash As Long, dwSigLen As Long
Dim i As Long
'initialise le système de crypto
Call CryptAcquireContext(hProv, 0&, vbNullString, PROV_RSA_FULL, 0&)
If hProv = 0 Then
Call CryptAcquireContext(hProv, 0&, vbNullString, PROV_RSA_FULL, 8&)
End If
'crée un hasheur
Call CryptCreateHash(hProv, AlgID, 0&, 0&, hHash)
'hash les données
Call CryptHashData(hHash, pbData, dwDataLen, 0&)
'récupère la valeur du hash dans un buffer
Call CryptGetHashParam(hHash, HP_HASHVAL, ByVal 0&, dwSigLen, 0)
If (dwSigLen) Then
ReDim outBuff(dwSigLen - 1)
Call CryptGetHashParam(hHash, HP_HASHVAL, ByVal VarPtr(outBuff(0)), dwSigLen, 0)
End If
'libère le hasheur
Call CryptDestroyHash(hHash)
'libère le système de crypto
Call CryptReleaseContext(hProv, 0&)
'renvoie la taille du hash
GetHashBin = dwSigLen
End Function
Public Function MD5Bin(ByVal pbData As Long, ByVal dwDataLen As Long) As Byte()
Call GetHashBin(CALG_MD5, pbData, dwDataLen, MD5Bin)
End Function
Public Function MD5String(ByVal pbData As Long, ByVal dwDataLen As Long) As String
MD5String = GetHashString(CALG_MD5, pbData, dwDataLen)
End Function