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
] |
