Bonjour le forum,

J'étais en train de préparer une contribution pour le forum concernant un suivi bancaire sur Excel et j'avous que je bloque un peu sur un problème de chiffrement.

Pour vous présentez le décor voici le modèle relationnel que j'ai conçu pour m'aider
Nom : Modèle Relationnel.png Affichages : 1693 Taille : 40,3 Ko

Vous pouvez voir que la feuille centrale est nommé FEC (Fichier des écritures comptable). En faite c'est un standard pour les entreprises en cas d'audit de la part de l'administration. Étant bien structuré, je n'aurais pas de mal à faire du reporting derrière et si un particulier se fait contrôler il pourra le donner. Afin de créer une sécurité des données, je me suis lancé dans l'idée de chiffrer/déchiffer les données.

Le problème est le suivant : J'ai des problèmes concernant le chiffrement de données via le cryptosystème Rinjdael (AES). Le vecteur est encodé sur 128 bits (16 bytes) et les block sur 128 (en output j'ai du 16 ou 32 bytes par blocs en général).

1 - Mais parfois j'ai des blocks non conforme (Inférieur à 16).
2 - Il arrive que le premier caractère soit ' et quand je souhaite déchiffrer Excel n'en tiens pas compte
3 - Je penses que j'ai un problème de conversion des bytes vers les caractères ASCII. (Fonction BytesToString)
4 - Parfois avec le bon vecteur cela marche nikel.

Pour illustrer voici une image des données en clair
Nom : Texte Claire.png Affichages : 1472 Taille : 25,0 Ko

Et voici le résultat une fois chiffré. Si tous c'est bien passé chaque chaine de texte doit avoir une longueur modulo 16

Nom : Text Chiffré.png Affichages : 1522 Taille : 36,3 Ko

Voici le code du module Sécurité :
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
'************************************************************************************************************
' NAME : MSecurity (MODULE)
' AUTHOR : John Mc Evee
' VERSION : 1.0
' DATE : 27/12/2018
' DESCRIPTION : Le module permet de se connecter et de dévérouiller les données grâce à un logging et un
' mot de passe. Avant de fermer le classeur, le processus va chiffrer les données afin de proteger les
' données contre une lecture par le mapping xml
' NOTE : Utilisation du hash SHA256 pour le mot de passe
'        Utilisation du cryptosystème Rinjdael pour le chiffrement et déchiffrement avec une clé de 128 bits
' et des blocs de 256 bits.
' L'application ne fonctionne que pour un seul identifiant car si l'on crée un nouvel identifiant et que
' les données sont chiffrés, il est impossible de les déchiffer sans avoir le mot de passe du dernier
' idenfiant connecté.
'************************************************************************************************************
Option Explicit
Option Base 0
 
'************************************************************************************************************
'                                            Variable privée
'************************************************************************************************************
Private oSheetData   As Excel.Worksheet     'Feuille contenant les données d'environement
Private oSheetFEC    As Excel.Worksheet     'Feuille contenant les données du FEC
Private oRangeData   As Excel.Range         'Plage contenant les données
Private oCellData    As Excel.Range         'Cellule Active
Private oCrypto      As VBA.Collection      'Contient les données chiffrés, la clé et l'IV
Private RMCrypto     As Object              'Object Rinjdael AES
Private SHA256       As Object              'Object SHA256
Private sData        As String              'Donnée en chaine de texte
Private sKey         As String              'Clé en chaine de texte
Private sIV          As String              'Vecteur d'initialisation en chaine de texte
Private sHash        As String              'Hash du mot de passe
Private lLastColumn  As Long                'Dernière colonne
Private lFirstColumn As Long                'Première colonne
Private lLastRow     As Long                'Dernière ligne
Private lFirstRow    As Long                'Première ligne
Private bPassword()  As Byte                'Byte du mot de passe
Private bData()      As Byte                'Donnée à chiffrer/Déchiffrer
Private bKey()       As Byte                'Clé de chiffrement/Déchiffrement
Private bIV()        As Byte                'Vecteur d'initialisation
 
'************************************************************************************************************
'                                               Public Methode
'************************************************************************************************************
 
'************************************************************************************************************
' NAME : Authentification (FUNCTION)
' INPUT : sUsername (String), sPassword (String)
' OUTPUT : True/False (Boolean)
' DESCRIPTION : Vérifie que l'utilisateur a saisi le bon mot de passe et dechiffre les données à l'aide du
' mot de passe et du vecteur d'initialisation du précédent chiffrement.
'************************************************************************************************************
Public Function Authentification(sUsername As String, sPassword As String) As Boolean
 
    Authentification = False 'Initialisation de la fonction
 
    Set oSheetData = ThisWorkbook.Worksheets("Environ")
 
    If oSheetData Is Nothing Then InfoUtilisateur _
    "La feuille Environ est introuvable", "Authentification", VBA.vbCritical
 
    With oSheetData
 
        'On set la colonne contenant les identifiants
        Set oRangeData = SetRange(oSheetData, 1, .Rows.Count, 1, 1)
 
        'On récupère le hash du mot de passe
        sHash = "ƒ]mÈ‹p‹ÆFÖÛ‚ÈSïA‚ú»Ô¨ÞYÂòµ«:çÙ¾"
        'sHash = oRangeData.Find(sUsername).Offset(0, 1).Value
        bPassword = StringToBytes(sPassword)
 
        'Si le Hash n'existe pas
        If sHash = VBA.vbNullString Then
 
            Authentification = False
            InfoUtilisateur "Identifiant non créé", "Authentification", VBA.vbCritical
 
        'Si le mot de passe est le bon
        ElseIf HashSHA256(bPassword) = sHash Then
 
            'Si l'utilisateur utilise le chiffrement
            If CBool(oRangeData.Find(sUsername).Offset(0, 5).Value) Then
 
                '********************************************************************************************
                'Déchiffrement de la feuille FEC
                '********************************************************************************************
                Set oSheetFEC = ThisWorkbook.Worksheets("FEC")
 
                If oSheetData Is Nothing Then
                    InfoUtilisateur "La feuille FEC est introuvable", "Authentification", VBA.vbCritical
                    Exit Function
                End If
 
                With oSheetFEC
 
                    'Fixe des dimensions
                    lFirstRow = 1
                    lLastRow = EndOf(oSheetFEC, .Rows.Count, 1, xlUp).Row
                    lFirstColumn = 1
                    lLastColumn = EndOf(oSheetFEC, 1, .Columns.Count, xlToLeft).Column
 
                    'Initialisation de la clé et du vecteur d'initialisation
                    bKey = StringToBytes(HashSHA256(StringToBytes(sUsername & sPassword)))
                    bIV = StringToBytes(oRangeData.Find(sUsername).Offset(0, 4).Value)
 
                    'Boucle sur les données du FEC
                    For Each oCellData In SetRange(oSheetFEC, lFirstRow, lLastRow, lFirstColumn, lLastColumn)
 
                        'On évite les cellules vide
                        If oCellData.Value <> VBA.vbNullString Then
 
                            'On converti les données
                            VBA.DoEvents
                            bData = StringToBytes(CStr(oCellData.Value))
                            Set oCrypto = Decryption(bData, bKey, bIV)
                            'On inscrit les données déchiffrer
                            oCellData.Value = BytesToString(oCrypto("Data"))
                            VBA.DoEvents
 
                        End If
 
                    Next oCellData
 
                End With
 
                Erase bData 'Vidange
                Erase bIV
                Erase bKey
                Set oCrypto = Nothing
 
            End If
 
            Authentification = True
 
        Else 'Si le mot de passe n'est pas le bon
 
            Authentification = False
            InfoUtilisateur "Mot de passe incorrect", "Authentification", VBA.vbCritical
 
        End If
 
        Set oRangeData = Nothing
 
    End With
 
    Set oSheetData = Nothing
 
End Function
 
'************************************************************************************************************
' NAME : Deconnexion (FUNCTION)
' INPUT : sUsername(String), bChiffrement (Boolean)
' OUTPUT : True/False (Boolean)
' DESCRIPTION : Chiffre les données du FEC avant la déconnexion du classeur si bChiffrement est à true
'************************************************************************************************************
Public Function Deconnexion(sUsername As String, sPassword As String, bChiffrement As Boolean) As Boolean
 
    ThisWorkbook.Save
 
    If bChiffrement Then
 
        Set oSheetData = ThisWorkbook.Worksheets("Environ")
 
        If oSheetData Is Nothing Then InfoUtilisateur _
        "La feuille Environ est introuvable", "Authentification", VBA.vbCritical
 
        With oSheetData
 
            'On set la colonne contenant les identifiants
            Set oRangeData = SetRange(oSheetData, 1, .Rows.Count, 1, 1)
            'Initialisation de la clé et du vecteur d'initialisation
 
            bKey = StringToBytes(HashSHA256(StringToBytes(sUsername & sPassword)))
            'On supprime l'IV
            oRangeData.Find(sUsername).Offset(0, 4).ClearContents
 
            'On génére un nouvel IV
            VBA.DoEvents
 
            bData = StringToBytes("Test")
            Set oCrypto = Encryption(bData, bKey)
            bIV = oCrypto("IV")
 
            sIV = BytesToString(oCrypto("IV"))
            oRangeData.Find(sUsername).Offset(0, 4).Value = sIV
            VBA.DoEvents
 
            '****************************************************************************************************
            ' Début du chiffrement
            '****************************************************************************************************
            Set oSheetFEC = ThisWorkbook.Worksheets("FEC")
 
            If oSheetData Is Nothing Then
                InfoUtilisateur "La feuille FEC est introuvable", "Authentification", VBA.vbCritical
                Exit Function
            End If
 
            With oSheetFEC
 
                'Fixe des dimensions
                lFirstRow = 1
                lLastRow = EndOf(oSheetFEC, .Rows.Count, 1, xlUp).Row
                lFirstColumn = 1
                lLastColumn = EndOf(oSheetFEC, 1, .Columns.Count, xlToLeft).Column
 
                'Boucle sur les données du FEC
                For Each oCellData In SetRange(oSheetFEC, lFirstRow, lLastRow, lFirstColumn, lLastColumn)
                     'On évite les cellules vide
                    If oCellData.Value <> VBA.vbNullString Then
 
                        'On converti les données
                        bData = StringToBytes(CStr(oCellData.Value))
                        Set oCrypto = Encryption(bData, bKey, bIV)
                        'On inscrit les données déchiffrer
                        oCellData.Value = BytesToString(oCrypto("Data"))
                        VBA.DoEvents
 
                    End If
 
                Next oCellData
 
            End With
 
        End With
 
    End If
 
    Deconnexion = True
 
End Function
 
'************************************************************************************************************
'                                               Private Methode
'************************************************************************************************************
 
'************************************************************************************************************
' NAME : Decryption (FUNCTION)
' INPUT : dData (Byte), bKey (Byte), bIV (Byte)
' OUTPUT : ClearText (Byte)
' DESCRIPTION : Return a clear text with key and initialisation vector
'************************************************************************************************************
Private Function Decryption(bData() As Byte, bKey() As Byte, bIV() As Byte) As VBA.Collection
 
    Dim bClearData() As Byte
    Dim Decode As Object
    Set Decryption = New VBA.Collection
    Set RMCrypto = VBA.CreateObject("System.Security.Cryptography.RijndaelManaged")
 
    With RMCrypto
 
        .KeySize = 256
        .BlockSize = 128
        .Mode = 1 'CBC
        .Key = bKey
        .IV = bIV
 
        VBA.DoEvents
        Set Decode = .CreateDecryptor()
        bClearData = Decode.TransformFinalBlock((bData), 0, VBA.LenB(bData))
 
        Decryption.Add bClearData, "Data"
        Decryption.Add .Key, "Key"
        Decryption.Add .IV, "IV"
 
    End With
 
    Set RMCrypto = Nothing
 
End Function
 
'************************************************************************************************************
' NAME : Encryption (FUNCTION)
' INPUT : dData (Byte)
' OUTPUT : sKey (String), sIV(String), CipherData (Byte)
' DESCRIPTION : Return a cipher text with key and initialisation vector
'************************************************************************************************************
Private Function Encryption(ByRef bData() As Byte, Optional bKey As Variant = Empty, _
                                                   Optional bIV As Variant = Empty) As VBA.Collection
 
    Dim bCipherData() As Byte
    Dim Encode        As Object
 
    Set Encryption = New VBA.Collection
 
    Set RMCrypto = VBA.CreateObject("System.Security.Cryptography.RijndaelManaged")
 
    With RMCrypto
 
        .KeySize = 256
        .BlockSize = 128
        .Mode = 1 'CBC
 
        Select Case VBA.VarType(bKey)
            Case VBA.vbArray + VBA.vbByte
                .Key = bKey
            Case VBA.vbEmpty
                .GenerateKey
        End Select
 
        Select Case VBA.VarType(bIV)
            Case VBA.vbArray + VBA.vbByte
                .IV = bIV
            Case VBA.vbEmpty
 
                Do
                .GenerateIV
                Loop While UBound(.IV) <> 15 '---> Pour forcer la bonne longueur de l'IV
 
        End Select
 
        VBA.DoEvents
        Set Encode = .CreateEncryptor()
 
        Do
 
            bCipherData = Encode.TransformFinalBlock((bData), 0, VBA.LenB(bData))
 
        Loop While UBound(bCipherData) < 15 '---> Pour éviter les mauvais blocks (Inf à 128 bits)
 
        Set Encode = Nothing
 
        Encryption.Add bCipherData, "Data"
        Encryption.Add .Key, "Key"
        Encryption.Add .IV, "IV"
 
    End With
 
    Erase bCipherData
 
    Set RMCrypto = Nothing
 
End Function
 
'************************************************************************************************************
' NAME : HashSHA256
' INPUT : TextBytes (Byte Array)
' OUTPUT : sHash (String)
' DESCRIPTION : Calculate hash of SHA256 algorithm
'************************************************************************************************************
Private Function HashSHA256(TextBytes() As Byte) As String
 
    Dim sHash As String
    Dim CipherHash() As Byte
 
    Set SHA256 = VBA.CreateObject("System.Security.Cryptography.SHA256Managed")
 
    With SHA256
        .Initialize
        CipherHash = .ComputeHash_2((TextBytes))
    End With
 
    Set SHA256 = Nothing
 
    HashSHA256 = BytesToString(CipherHash)
 
End Function
 
'************************************************************************************************************
' NAME : StringToBytes (FUNCTION)
' INPUT : sData (String)
' OUTPUT : Byte Array
' DESCRIPTION : Converti une chaine de texte en byte
'************************************************************************************************************
Private Function StringToBytes(sData As String) As Byte()
 
    StringToBytes = VBA.StrConv(sData, VBA.vbFromUnicode)
    VBA.DoEvents
 
End Function
 
'************************************************************************************************************
' NAME : BytesToString (FUNCTION)
' INPUT : dData (Byte)
' OUTPUT : String
' DESCRIPTION : Converti une chaine de byte en string (Code ASCII)
'************************************************************************************************************
Private Function BytesToString(bData() As Byte) As String
 
    BytesToString = VBA.StrConv(bData, VBA.vbUnicode)
    VBA.DoEvents
 
End Function
Pour les fonctions Standard :
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
'************************************************************************************************************
' NAME : MFunction (MODULE)
' DESCRIPTION : Module contenant des functions standards et utilié dans les différents modules
'************************************************************************************************************
Option Explicit
 
'************************************************************************************************************
' NAME : EndOf (FUNCTION)
' INPUT : oSheetData (Worksheet), lRow (Long), lColumn (Long), eDirection (XlDirection), sType(String)
' OUTPUT : EndOf (Range)
' DESCRIPTION : Retourne la cellule spécifié par l'énumération en partant des coordonnées (lRow, lColumn)
' NOTE : Pour récupérer le numéro de colonne (EndOf.column)
'************************************************************************************************************
Public Function EndOf(oSheetData As Excel.Worksheet, lRow As Long, lColumn As Long, _
                      eDirection As XlDirection) As Excel.Range
 
    Set EndOf = oSheetData.Cells(lRow, lColumn).End(eDirection)
 
End Function
 
'************************************************************************************************************
' NAME : Apps (PROCESS)
' INPUT : bStart (Boolean)
' DESCRIPTION : Désactive/Active des paramètres par défaut de l'application afin de gagner en efficacité
'************************************************************************************************************
Public Sub Apps(bStart As Boolean)
 
    With Application
 
        If bStart Then
            .ScreenUpdating = False
        Else
            .ScreenUpdating = True
        End If
 
    End With
 
End Sub
'************************************************************************************************************
' NAME : SetRange
' INPUT : lFirstRow (long), lLastRow (Long), LFirstColumn (Long), lLastColumn (Long)
' DESCRIPTION : Set une range en fonction de 4 points de coordonées
'************************************************************************************************************
Public Function SetRange(oSheetData As Excel.Worksheet, lFirstRow As Long, lLastRow As Long, _
                         lFirstColumn As Long, lLastColumn As Long) As Excel.Range
    With oSheetData
        Set SetRange = .Range(.Cells(lFirstRow, lFirstColumn), .Cells(lLastRow, lLastColumn))
    End With
 
End Function
 
'************************************************************************************************************
' NAME : InfoUtilisateur
' INPUT : sInfo (String), sProcess(String), eBox (VbMsgBoxResult)
' DESCRIPTION : Renvoi un message d'erreur à l'utilisateur
'************************************************************************************************************
Public Sub InfoUtilisateur(sInfo As String, sProcess As String, eBox As VbMsgBoxResult)
 
    VBA.MsgBox sInfo & VBA.vbNewLine & sProcess, eBox
 
End Sub
Enfin voici une image de la table Environ pour faire le lien avec les données récupérer par le module
Nom : TableUser.png Affichages : 1459 Taille : 8,2 Ko

N'hésitez pas si j'ai manqué de précision et si vous souhaitez que je mettes à disposition un fichier de Test.

Je vous remercie par avance de votre aide.

A+