'contexte RSA signature
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_SHA As Long = 4
Private Const AT_SIGNATURE As Long = 2
Private Const CALG_HUGHES_MD5 As Long = &HA003&
Private Const CALG_HMAC As Long = &H8009&
Private Const CALG_MAC As Long = &H8005&
Private Const CALG_MD2 As Long = &H8001&
Private Const CALG_MD4 As Long = &H8002&
Private Const CALG_MD5 As Long = &H8003&
Private Const CALG_SHA As Long = &H8004&
'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
'différents algorithmes de hachage
'avec réponse binaire
Public Function SHABin(ByVal pbData As Long, ByVal dwDataLen As Long) As Byte()
Call GetHashBin(CALG_SHA, pbData, dwDataLen, SHABin)
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 MD4Bin(ByVal pbData As Long, ByVal dwDataLen As Long) As Byte()
Call GetHashBin(CALG_MD4, pbData, dwDataLen, MD4Bin)
End Function
Public Function MD2Bin(ByVal pbData As Long, ByVal dwDataLen As Long) As Byte()
Call GetHashBin(CALG_MD2, pbData, dwDataLen, MD2Bin)
End Function
'ou ascii
Public Function SHAString(ByVal pbData As Long, ByVal dwDataLen As Long) As String
SHAString = GetHashString(CALG_SHA, pbData, dwDataLen)
End Function
Public Function MD5String(ByVal pbData As Long, ByVal dwDataLen As Long) As String
MD5String = GetHashString(CALG_MD5, pbData, dwDataLen)
End Function
Public Function MD4String(ByVal pbData As Long, ByVal dwDataLen As Long) As String
MD4String = GetHashString(CALG_MD4, pbData, dwDataLen)
End Function
Public Function MD2String(ByVal pbData As Long, ByVal dwDataLen As Long) As String
MD2String = GetHashString(CALG_MD2, pbData, dwDataLen)
End Function