VB2008 : MD5 et RC4 : j'ai besoin d'aide pour vérifier mon script svp, je ne par

arcadoli Messages postés 1 Date d'inscription lundi 15 septembre 2008 Statut Membre Dernière intervention 3 avril 2010 - 3 avril 2010 à 01:38
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 3 avril 2010 à 08:06
Bonjour/bonsoir à vous,

J'hésite toujours à demander de l'aide, je fais ce que je peux pour chercher tout seul, mais là j'avoue que je suis un peu perdu...
Je voudrais qu'à partir d'un mot de passe, genre 'bonjour', le MD5 me génère une chaine de 32 caractères Hexa, soit 16 bits,
et qu'ensuite avec cette chaine, mon fichier soit encrypté avec RC4.
En entrée, j'ai un fichier binaire, je convertis les caractères en ANSI et je fais pareil à la sortie de mon script.
Le problème, c'est que si je repasse le même fichier, il ne se décrypte pas....

Voici mon code ci-dessous. Je ne comprends pas tout car j'ai biensur trouvé les sources sur intenet.
J'hésite d'ailleurs sur quelle valeur donner à Private Const ENCRYPT_BLOCK_SIZE = 1

[code=vb
Module Module5

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
ByRef phProv As Integer, _
ByVal pszContainer As String, _
ByVal pszProvider As String, _
ByVal dwProvType As Integer, _
ByVal dwFlags As Integer) As Integer

Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
ByVal hProv As Integer, _
ByVal Algid As Integer, _
ByVal hKey As Integer, _
ByVal dwFlags As Integer, _
ByRef phHash As Integer) As Integer

Private Declare Function CryptHashData Lib "advapi32.dll" ( _
ByVal hHash As Integer, _
ByRef pbData As String, _
ByVal dwDataLen As Integer, _
ByVal dwFlags As Integer) As Integer

Private Declare Function CryptDeriveKey Lib "advapi32.dll" ( _
ByVal hProv As Integer, _
ByVal Algid As Integer, _
ByVal hBaseData As Integer, _
ByVal dwFlags As Integer, _
ByRef phKey As Integer) As Integer

Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
ByVal hHash As Integer) As Integer

Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
ByVal hKey As Integer) As Integer

Private Declare Function CryptEncrypt Lib "advapi32.dll" ( _
ByVal hKey As Integer, _
ByVal hHash As Integer, _
ByVal Final As Integer, _
ByVal dwFlags As Integer, _
ByVal pbData As String, _
ByVal pdwDataLen As Integer, _
ByVal dwBufLen As Integer) As Integer

Private Declare Function CryptDecrypt Lib "advapi32.dll" ( _
ByVal hKey As Integer, _
ByVal hHash As Integer, _
ByVal Final As Integer, _
ByVal dwFlags As Integer, _
ByVal pbData As String, _
ByRef pdwDataLen As Integer) As Integer

Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As Integer, _
ByVal dwFlags As Integer) As Integer

Private Declare Function GetLastError Lib "kernel32" () As Integer

Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _
ByVal pCryptHash As Integer, _
ByVal dwParam As Integer, _
ByRef pbData As Object, _
ByRef pcbData As Integer, _
ByVal dwFlags As Integer) As Integer



'constants for Cryptography API functions
Private Const MS_DEF_PROV = "Microsoft base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_CLASS_HASH = 32768
Private Const CRYPT_NEWKEYSET = &H8
Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536
Private Const ALG_TYPE_STREAM = 2048
Private Const CRYPT_VERIFYCONTEXT As Integer = &HF0000000
Private Const ALG_SID_RC2 = 2

Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_MD5 = 3
Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)

Private Const ENCRYPT_ALGORITHM = CALG_RC4
Private Const ENCRYPT_BLOCK_SIZE = 1
' Private Const CRYPT_NO_SALT As Long = &H10
Private Const CRYPT_EXPORTABLE = 1

Private Const HP_HASHVAL As Integer = 2
Private Const HP_HASHSIZE As Integer = 4




Public Function DoCryptoDecrypt(ByVal data As String) As String

Dim lHExchgKey As Integer
Dim lHCryptprov As Integer = &H0
Dim lHHash As Integer = &H0
Dim lHkey As Integer = &H0
Dim lResult As Integer

Dim sContainer As String = Nothing
Dim sProvider As String

Dim sCryptBuffer As String
Dim lCryptBufLen As Integer
Dim lCryptPoint As Integer

Dim lPasswordPoint As Integer
Dim lPasswordCount As Integer
Dim password As String = "bonjouryo"
Dim sOutputBuffer As String

On Error GoTo DecryptError

'Clear the Output buffer
sOutputBuffer = Nothing

'Get handle to the default CSP.
sContainer = Nothing
sProvider = Nothing
sProvider = MS_DEF_PROV


If CryptAcquireContext(lHCryptprov, sContainer, sProvider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) = 0 Then
If CryptAcquireContext(lHCryptprov, sContainer, sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0 Then
MsgBox("Error " & CStr(GetLastError) & " during CryptAxquireContext! ")
GoTo Finished
End If
End If

'Create a hash object
If CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash) = 0 Then
MsgBox("Error " & CStr(GetLastError) & " during CryptCreateHash! ")
GoTo Finished
End If

'Hash in the password text
If CryptHashData(lHHash, password, Len(password), 0) = 0 Then
MsgBox("Error " & CStr(GetLastError) & " during CryptHashData!")
GoTo Finished
End If



' ------------------- Test pour retourner la clé de hashage -------------------
'Const cstBufferSize As Integer = 256
'Dim abytBuffer() As Byte ' Byte array buffer.
'Dim lngHashLength As Integer ' Length of the Hash.
'Dim strHash As String = Nothing
'Dim lngDataLen As Long
'Dim lngHashSize As Long
'Dim bytHashValue() As Byte
' Resize the byte array buffer.
'ReDim abytBuffer(cstBufferSize - 1)
'lngDataLen = 4 '4 bytes for Long length.
'If CryptGetHashParam(lHHash, HP_HASHSIZE, lngHashSize, lngDataLen, 0&) = 0 Then
' MsgBox("Error " & CStr(GetLastError) & " during GetHashParam1!")
' GoTo Finished
'Else
' lngDataLen = lngHashSize
' ReDim bytHashValue(lngDataLen - 1)
'End If

'' The length of the hash can be found in the first byte array position of the buffer.
' lngHashLength = abytBuffer(0)

'' Get the hash value (HP_HASHVAL).
'' The hash value. The pbData buffer will contain the hash value or message hash for the
'' hash object specified by hHash. This value is generated based on the data supplied earlier to the
'' hash object through the CryptHashData and CryptHashSessionKey functions.
'If CryptGetHashParam(lHHash, HP_HASHVAL, bytHashValue(0), lngDataLen, 0&) = 0 Then
' Err.Raise(vbObjectError Or &HC324&, _
' "MD5Hash", _
' "Failed to obtain hash value, system error " _
' & CStr(Err.LastDllError))

'Else
' Dim intByte As Integer
' Dim hashvalue As String = Nothing
' For intByte = 0 To lngDataLen - 1
' hashvalue = hashvalue & Right$("0" & Hex$(bytHashValue(intByte)), 2)
' Next
'End If

'' Convert the byte array to a VB string.
'For intI = 0 To lngHashLength
' strHash = strHash & Chr(abytBuffer(intI))
'Next intI

'' Return the hashed data as a VB string.
'Dim MD5Hash As String
'MD5Hash = strHash
'' ---------- Fin test ----------------------------------------------------------



'Create a session key from the hash object
If CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey) = 0 Then
MsgBox("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
GoTo Finished
End If

'Destroy the hash object.
CryptDestroyHash(lHHash)
lHHash = 0

'Prepare sCryptBuffer for CryptDecrypt
lCryptBufLen = Len(data) * 4

If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, data, Len(data))) Then
' If Not CBool(CryptEncrypt(lHkey, 0, 1, 0, data, Len(data), lCryptBufLen)) Then
MsgBox("bytes required: " & CStr(lCryptBufLen))
MsgBox("Error " & CStr(GetLastError) & " during CryptDecrypt!")
GoTo Finished
End If

'Setup output buffer with just decrypted data
sOutputBuffer = data

Finished:
'Outa here
DoCryptoDecrypt = sOutputBuffer

'Destroy session key
If (lHkey) Then lResult = CryptDestroyKey(lHkey)

'Destroy key exchange key handle
If lHExchgKey Then CryptDestroyKey(lHExchgKey)

'Destroy hash object
If lHHash Then CryptDestroyHash(lHHash)

'Release Context provider handle
If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

Exit Function


DecryptError:
MsgBox("Decrypt Error")
GoTo Finished
End Function

End Module

/code


Voilà, j'espère que vous pourrez m'aider. Je vous en remercie d'avance.
Cordialement,
Olivier.

1 réponse

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
3 avril 2010 à 08:06
etrange, je trouve que tu utilises les APIs...
le framework ne dispose-t'il pas d'objets dedies a la cryptographie ?


Renfield - Admin CodeS-SourceS - MVP Visual Basic & Spécialiste des RegExp
0
Rejoignez-nous