'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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.