Fonctions de hachage SHA, MD2, MD4, MD5

Commenter

Contenu du snippet 

'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

Compatibilité : VB6

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

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.

Du même auteur (ShareVB)