Fonction de cryptage en VBA (Tutoriel de Maxence HUBICHE)

**dde78** · 08/03/2006, 11h05

Bonjour à tous,

Je me penche depuis quelques temps sur le tuto suivant :
http://mhubiche.developpez.com/Acces...tage/vigenere/ qui est fort intéressant.
Bien qu'ayant compris le fonctionnement global de la fonction je n'arrive pas à écrire correctement la fonction inverse de décryptage butant notamment sur la ligne suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Mid(sLettres, lCompteur, 1) = Chr((Asc(Mid(chaîneACrypter, lCompteur, 1)) + _
					(Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur)) Mod 256)

En remplaçant le signe d'addition par une soustraction j'arrive à décrypter le premier caractère mais pas plus

Merci d'avance si vous pouvez m'apporter un peu d'aide

**dde78** · 14/03/2006, 12h01

Donc voilà j'arrive maintenant à décrypter mais sans intégrer dans le cryptage la multiplication suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

*lLongueur

c'est à dire que dans la fonction de cryptage au lieu d'avoir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Mid(sLettres, lCompteur, 1) = Chr((Asc(Mid(chaîneACrypter, lCompteur, 1)) + _ 
               (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur)) Mod 256)

j'écris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Mid(sLettres, lCompteur, 1) = Chr((Asc(Mid(chaîneACrypter, lCompteur, 1)) + _ 
               (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)))) Mod 256)

Je vous soumets ma fonction de décryptage pour voir si vous pouvez m'aider, svp, à intégrer le *lLongueur

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
 
Function Decrypter(ByVal chaîneADecrypter As String)
 
    Dim sLettres    As String
    Dim lCompteur   As Long
    Dim lLongueur   As Long
    Dim lBoucle     As Long
 
    Const CLEF As String = "nbvfdszé""'(-è_ijhgfcKLKjhgyuilM^+)àçiu-('32azsDRtvBhujkoç_è6tre""zsXWqazerfcx<;:<?"
    Const NBROTATIONSMAX    As Long = 13
 
    lLongueur = Len(chaîneADecrypter)
    sLettres = String(lLongueur, Chr(0))
 
    For lBoucle = 1 To NBROTATIONSMAX
 
        For lCompteur = 1 To lLongueur
 
           If (Asc(Mid(chaîneADecrypter, lCompteur, 1)) + 256) - (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1))) < 256 Then
 
                Mid(sLettres, lCompteur, 1) = Chr((Asc(Mid(chaîneADecrypter, lCompteur, 1)) + 256) - _
                (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1))))
 
           Else
 
                Mid(sLettres, lCompteur, 1) = Chr(((Asc(Mid(chaîneADecrypter, lCompteur, 1))) - _
                (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)))) Mod 256)
 
           End If
 
        Next
 
        chaîneADecrypter = sLettres
 
    Next
 
    Decrypter = sLettres
 
End Function

**Muhad'hib** · 14/03/2006, 13h25

Salut,

Si tu veux voici ce que j'avais fait il y a qques temps à partir du tuto de Maxence HUBICHE :

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
Option Compare Database
Option Explicit
    'Définition des constantes utiles pour la fonction Crypter et deCrypter (Clé et nombre d'itérations de la fonction maximum)
    Const Clef              As String = "toto"
    Const NBROTATIONSMAX    As Long = 11
 
Function Crypter(ByVal chaîneACrypter As String)
'---------------------------------------------------------------------------------------
' Procedure : Crypter
' Créée le  : lundi 18 juil 2005 18:51
' Auteur    : Maxence HUBICHE
' Site      : http://mhubiche.developpez.com
' Objet     : Crypter la chaîne chaîneACrypter en fonction d'une clef et de la méthode
'               de Vigenère
'---------------------------------------------------------------------------------------
'
    Dim sLettres    As String
    Dim lCompteur   As Long
    Dim lLongueur   As Long
    Dim lBoucle     As Long
 
 
    'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
    lLongueur = Len(chaîneACrypter)
    sLettres = String(lLongueur, Chr(0))
'Trucs de codage
'Vous ne le saviez peut-être pas, mais, lorsque vous écrivez ceci :
'Dim s As String
's = "A"
's = s & "B"
'Vous utilisez énormément de ressources système (enfin ... tout est relatif) car, il y a création de la variable s pour stocker "A", puis pour ajouter le "B", il va falloir que le système recrée une variable contenant les 2 caractères ; alors que si on avait écrit ceci :
's = "xx"
'Mid(s, 1, 1) = "A"
'Mid(s, 2, 1) = "B"
'nous utilisons toujours la même variable, et nous la modifions au fur et à mesure qu'on modifie la position d'un caractère. Cette deuxième écriture demande donc moins de traitements au procésseur et est donc plus rapide au niveau traitement. C'est donc la solution que j'ai favorisé dans le code de la fonction.
 
 
    'Boucler en fonction du nombre de rotations attendues
    For lBoucle = 1 To NBROTATIONSMAX
        'boucler pour chaque caractère de la chaîne initiale
        For lCompteur = 1 To lLongueur
            'Remplacer le caractère de la chaîne à crypter par le caractère correspondant à
            '   le reste de
            '       la valeur ascii du caractère à crypter
            '       plus
            '       la valeur ascii du caractère correspondant dans la clé, multiplié par la longueur de la clé
            '   quand on le divise par 256
            Mid(sLettres, lCompteur, 1) = Chr((Asc(Mid(chaîneACrypter, lCompteur, 1)) + _
                    (Asc(Mid(Clef, (lCompteur Mod Len(Clef)) + 1, 1)) * lLongueur)) Mod 256)
        'recommencer
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        chaîneACrypter = sLettres
    'Nouvelle itération
    Next
    'Renvoyer le résultat final
    Crypter = sLettres
End Function
 
Function deCrypter(ByVal chaîneAdeCrypter As String)
'---------------------------------------------------------------------------------------
' Procedure : deCrypter
' Créée le  : jeudi 8 septembre 2005
' Auteur    : Muhad'hib (d'aprés Maxence HUBICHE)
' Site      :
' Objet     : deCrypter la chaîne chaîneAdeCrypter en fonction d'une clef et de la méthode
'               de Vigenère
'---------------------------------------------------------------------------------------
'
    Dim sLettres    As String
    Dim lCompteur   As Long
    Dim lLongueur   As Long
    Dim lBoucle     As Long
 
 
    'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
    lLongueur = Len(chaîneAdeCrypter)
    sLettres = String(lLongueur, Chr(0))
 
 
    'Boucler en fonction du nombre de rotations attendues
    For lBoucle = 1 To NBROTATIONSMAX
        'boucler pour chaque caractère de la chaîne initiale
        For lCompteur = 1 To lLongueur
            'Remplacer le caractère de la chaîne à crypter par le caractère correspondant à
            '   le reste de
            '       la valeur ascii du caractère à crypter
            '       plus
            '       la valeur ascii du caractère correspondant dans la clé, multiplié par la longueur de la clé
            '   quand on le divise par 256
            Dim reste As Integer
            reste = Asc(Mid(chaîneAdeCrypter, lCompteur, 1))
 
 
 
 
 
            Mid(sLettres, lCompteur, 1) = Chr((((Asc(Mid(chaîneAdeCrypter, lCompteur, 1)) - _
                    (Asc(Mid(Clef, (lCompteur Mod Len(Clef)) + 1, 1)) * lLongueur)) Mod 256) + 256) Mod 256)
        'recommencer
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        chaîneAdeCrypter = sLettres
    'Nouvelle itération
    Next
    'Renvoyer le résultat final
    deCrypter = sLettres
End Function

En espérant que cela t'aidera.

A+

**dde78** · 14/03/2006, 14h01

Merci beaucoup Muhad'hib, effectivement, en étudiant ta fonction, je m'aperçois que mon algo était vraiment bancal

maintenant c'est bon j'ai pigé ; merci

**Hanyf** · 16/03/2016, 22h17

Envoyé par dde78

Merci beaucoup Muhad'hib, effectivement, en étudiant ta fonction, je m'aperçois que mon algo était vraiment bancal

maintenant c'est bon j'ai pigé ; merci

Je confirme, voici une application des 2 fonctions : Crypter et Décrypter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub testCryptage()
    Dim strMsg As String
    Dim strCipher As String
    strMsg = "Bonjour A Tous !"
 
    strCipher = Crypter(strMsg)
 
    MsgBox strCipher, vbInformation, "CIPHER :"
 
     MsgBox deCrypter(strCipher), vbInformation, "DECODAGE : "
End Sub