j'ai pu rsoudre mon prob d cryptoAPI
si vous etes intéressez voila le code pour crypter une chaine avec un mot passe.al'aide des fcts de cryptoAPI.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
'-----------------------------------Fonction CryptoAPI-------------*---------------------------
Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
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
Declare Function CryptHashData Lib "advapi32.dll" (ByVal hhash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hhash As Long) As Long
Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hkey As Long, ByVal hhash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hkey As Long, ByVal hhash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
'-------------------------------------Variables et constantes-------------------------------------------------
'Type algorithme
Const ALG_TYPE_ANY      As Long = 0
Const ALG_TYPE_BLOCK    As Long = 1536
'classe algorithme
Const ALG_CLASS_DATA_ENCRYPT  As Long = 24576
Const ALG_CLASS_HASH    As Long = 32768
' Hash IDs
Const ALG_SID_SHA1      As Long = 4
Const ALG_SID_RC2       As Long = 2
'algo de hash
Const CALG_SHA1         As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
Const CALG_RC2          As Long = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2
Const PROV_RSA_FULL  As Long = 1
Dim m_strInputData          As String
Dim m_lngCryptContext       As Long
'Microsoft provider
Const MS_PROVIDER  As String = "Microsoft Base Cryptographic Provider v1.0"
'-------------------------------------------Fonction Encrypt-----------------------------------------------
 Function Encrypt(s As String, psw As String) As String
Dim lngHashHwd      As Long     ' Hash handle
Dim lngkey         As Long
Dim lngRetCode      As Long     ' return value from an API call
Dim lngHExchgKey    As Long
Dim strOutputData   As String
Dim lngEnctBuffLen  As Long
Dim strEncBuffer  As String
Dim lngEncDataLength As Long
Dim strTemp As String
strTemp = vbNullChar
'obtenir le handle de CSP spécifié------------------------------------------------------------------------
If Not CBool(CryptAcquireContext(m_lngCryptContext, strTemp, MS_PROVIDER, PROV_RSA_FULL, 0)) Then
 
    MsgBox "Error  en CryptAcuireContext()...!!!"
 
End If
'Permet d'obtenir un handle qui sera utilisé pour effectuer un hash sur un flux de données------------------
If Not CBool(CryptCreateHash(m_lngCryptContext, CALG_SHA1, 0, 0, lngHashHwd)) Then
 
      MsgBox "Erreur en CryptCreateHash()...!!!"
 
End If
'Hash les données spécifiées (psw) par l'objet spécifié par le handle------------------------------------------
If Not CBool(CryptHashData(lngHashHwd, psw, Len(psw), 0)) Then
 
       MsgBox "Error en CryptHashData()...!!!"
End If
 
'Génère une clé de session dérivée à partir de données de base-----------------------------------------------
If Not CBool(CryptDeriveKey(m_lngCryptContext, CALG_RC2, lngHashHwd, 0, lngkey)) Then
 
          MsgBox "Error en DeriveKey()...!!!"
End If
 
'alouer l'espace suffisant
lngEncDataLength = Len(s)
lngEnctBuffLen = lngEncDataLength * 2
strEncBuffer = String$(lngEnctBuffLen, vbNullChar)
LSet strEncBuffer = s    'LSet stringvar = string 'aligner a gauche la chaine s
 
'Crypter les doneés (Chaine s)--------------------------------------------------------------------------------
If Not CBool(CryptEncrypt(lngkey, 0, 1, 0, strEncBuffer, lngEncDataLength, lngEnctBuffLen)) Then
 
    MsgBox "Error en CryptEncrypt()...!!!"
 
End If
        strOutputData = Mid$(strEncBuffer, 1, lngEncDataLength)
        Encrypt = strOutputData 'la chiane est Cryptée
 
  ' --------------------Libèré les handle de clé-----------------------
    If lngkey <> 0 Then
        lngRetCode = CryptDestroyKey(lngkey)
    End If
 
    If lngHashHnd <> 0 Then
        lngRetCode = CryptDestroyHash(lngHashHwd)
    End If
 
 
    '----------------------------- Vider les variables-----------------------------------
 
    lngHashHwd = 0
    psw = String$(250, 0)
    'ingkey = 0
 
End Function
]
pour le plus ample information di le moi
je vai vous détaillez..!
Merci