[OFFICE VBA] Ecrire une fonction de décryptage [Résolu]

[Arkham46]

Bonjour à tous,

Je vous propose aujourd'hui un petit défi : écrire une fonction de décryptage connaissant la fonction de cryptage.

Maxence HUBICHE nous livre une fonction de cryptage dans cet article :
Une petite fonction de cryptage en VBA

Le défi est d'écrire une fonction Decrypter inverse de la fonction Crypter.

Pour tester la fonction écrite, il suffit d'enchaîner les deux fonctions.
On doit retrouver la chaîne de caractères d'origine.
Par exemple, dans la fenêtre d'exécution :

Code :

? Decrypter(Crypter("Developpez.com défi décryptage 01234567890"))

Doit renvoyer le texte : Developpez.com défi décryptage 01234567890

Ceci est un "défi éclair", poster votre fonction dans cette discussion dès que vous avez la solution.
Je dévoilerai alors ma fonction à la suite.

A vos méninges!

[Maxence HUBICHE]

J'ai le droit de jouer ? Dis ... J'ai le droit ?

[Arkham46]

Envoyé par Maxence HUBICHE

J'ai le droit de jouer ? Dis ... J'ai le droit ?

si personne d'autre ne trouve

[Cl@udius]

Et moi le delphiste que je suis, y peux ?

Ça ce résume à 1 ligne de code dans les 2 boucles imbriquées.

[Arkham46]

Envoyé par Cl@udius

Et moi le delphiste que je suis, y peux ?

Ça ce résume à 1 ligne de code dans les 2 boucles imbriquées.

Je ne vais pas faire mon rabat-joie et vous empêcher tous de jouer

[Maxence HUBICHE]

Bon, allez... j'attends la fin de la semaine pour savoir si je peux gagner une sucette ou pas

[patbou]

bonjour,

Voici ma fonction décryptage
Pas très propre mais bon c 'est pour le jeu

Code :

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
 
Function décryptage(ByVal chaîneAD2crypter As String)
Dim div
Dim lcompteur As Long
Dim mot_codé As String
Dim val_cod
Dim clef_ch
Dim asc_mot_codé
Dim lLongueur As Long
Dim ofset As Integer
Dim res
Dim sLettres    As String
Dim lBoucle     As Long
 
Const NBROTATIONSMAX    As Long = 26
Const CLEF   As String = "nbvfdszé""'(-è_ijhgfcKLKjhgyuilM^+)àçiu-('32azsDRtvBhujkoç_è6tre""zsXWqazerfcx<;:<?"
 
chaîneAD2crypter = Crypter(chaîneAD2crypter)
lLongueur = Len(chaîneAD2crypter)
sLettres = String(lLongueur, Chr(0))
For lBoucle = 1 To NBROTATIONSMAX
    For lcompteur = 1 To lLongueur
        clef_ch = Asc(Mid(CLEF, (lcompteur Mod Len(CLEF)) + 1, 1)) * lLongueur
        asc_mot_codé = Asc(Mid(chaîneAD2crypter, lcompteur, 1))
        div = clef_ch \ 256
        val_cod = (div * 256) + asc_mot_codé
            If val_cod < clef_ch Then
                ofset = 256
                    Else: ofset = 0
            End If
        res = val_cod + ofset - clef_ch
    Mid(sLettres, lcompteur, 1) = Chr(res)
    Next lcompteur
      chaîneAD2crypter = sLettres
Next lBoucle
décryptage = sLettres
 
End Function

[Arkham46]

Envoyé par patbou

bonjour,

Voici ma fonction décryptage
Pas très propre mais bon c 'est pour le jeu

[...]

Bien joué !

Voilà donc ma fonction :

Code :

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
 
Public Function Decrypter(ByVal pChaine As String)
'---------------------------------------------------------------------------------------
' Procedure : Decrypter
' Créée le  : 25 juin 2008 18:51
' Auteur    : Thierry GASPERMENT
' Site      : http://arkham46.developpez.com
' Objet     : Decrypter la chaîne 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
    Dim lLenValues  As Long
    Dim lPosition   As Long
 
    'Définition des constantes utiles pour la fonction (Clé et nombre d'itérations de la fonction maximum)
    Const CLEF              As String = "nbvfdszé""'(-è_ijhgfcKLKjhgyuilM^+)àçiu-('32azsDRtvBhujkoç_è6tre""zsXWqazerfcx<;:<?"
    Const NBROTATIONSMAX    As Long = 13
 
    'Définition de la longueur de la chaîne à crypter et de la chaîne de résultat
    lLongueur = Len(pChaine)
    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
            Mid(sLettres, lCompteur, 1) = Chr((Asc(Mid(pChaine, lCompteur, 1)) + 256 - (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur) Mod 256) Mod 256)
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        pChaine = sLettres
    'Nouvelle itération
    Next
    'Renvoyer le résultat final
    Decrypter = sLettres
End Function

J'ai un peu galéré pour tout mettre dans une ligne

Encore bravo à patbou.

[Cl@udius]

Et voilà pour ma part:

Code :

1
2
3
4
5
6
7
8
9
10
11
Function Decrypter(ByVal S As String)
    Dim I As Long, J As Long, L As Long
 
    Decrypter = S
    L = Len(S)
    For I = 1 To NBROTATIONSMAX
        For J = 1 To L
            Mid(Decrypter, J, 1) = Chr(((Asc(Mid(Decrypter, J, 1)) - (Asc(Mid(CLEF, J Mod Len(CLEF) + 1, 1)) * L) Mod 256) + 256) Mod 256)
        Next
    Next
End Function

@+

[Maxence HUBICHE]

bon, ben ... tant pis alors... avec trois réponses, je m'incline
Pour ma part, j'avais la même solution que cl@udius, mais avec la totalité du code autour et après avoir sorti les constantes de la procédure crypter pour en étendre la portée au module...
vàlà vàlà...

[Arkham46]

bravo et merci à vous

maintenant on sait décrypter la fonction de maxence

[JMPS.VBA]

Pensez aussi que vous risquez deux choses qui pourraient faire planter votre programme
1. L'addition des 2 codes ASCII risque de dépasser la valeur 255, ce qui n'est pas acceptable, les valeurs de la table ASCII étant comprises entre 0 et 255. un moyen de passer outre cette limite sera d'utiliser le modulo (reste d'une division entière) par 256
2. La longueur de la chaîne à crypter pourrait être plus longue que votre clé, ce qui implique de retourner au début de la clé à chaque fois qu'on est arrivé à la fin. Encore une fois, le modulo par la longueur de la chaîne devrait nous permettre de nous en sortir.

Et aussi une troisième: Les codes des caractères inférieurs à 32 ne sont pas toujours utilisables sous MS-Office.

Par conséquent, un valeur cryptée à l'aide de la méthode de maxence ne peut pas être stockée dans une cellule pour être décryptée plus tard...

Mon défit à moi sera peut être de limiter l'alphabet utilisable aux caractères imprimables entre 32 et 255 dans la table ascii.

La seule chose, c'est comment faire ?... C'est mon défit... Je reviendrai que quand je saurais faire... Au revoir pour un bout de temps... ;D Content de vous avoir connu ...

[Arkham46]

Bjr,

Envoyé par JMPS.VBA

Mon défit à moi sera peut être de limiter l'alphabet utilisable aux caractères imprimables entre 32 et 255 dans la table ascii.

Voir ici :
http://www.developpez.net/forums/d36...ence-cryptees/
On peut définir les caractères utilisables.

[JMPS.VBA]

Voir ici

C'est pas drôle !

Mais bon.... je suis faible.... alors j'y vais...

Mais je maintien que c'est pas drôle !

___________________
PS : Merci quand même

[JMPS.VBA]

Mon soucis c'est que je peux le faire avec une fonction de feuille de calcul, mais le code de Arkham46 est trop imbriqué pour mes petits neurones. je ne le comprends pas à ces heures tardives (même le matin j'aurais du mal de toute façon).
Un petit coup de main je veux bien.

dans une feuille de calcul je pose :

Colonne A = CODE(Caractère Clair) 'Obligatoirement >=32 et <=255
Colonne B = CODE(Caractère de la Clef) 'Obligatoirement >=32 et <=255
Colonne C = A1 + B1

Pour générer un caractère crypté compris entre 32 et 255:
Colonne D = MOD(C1;224)+32

Pour retrouver le caractère clair
Colonne E =MOD(((D1+224)-(MOD(B1;224)+32))-32;224)+32


Donc le code VBA devrait être : je ne le met pas entre balises de code exprès pour conserver la couleur des parenthèses et essayer de comprendre l'erreur dans les imbrications ....

Pour coder :
___________________________
Mid(sLettres, lCompteur, 1) =

Chr(((Asc(Mid(pChaine, lCompteur, 1)) + (Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur)) Mod 224) + 32)
___________________________
OUI, Ok, Ça fonctionne


Pour décoder :
___________________________
Mid(sLettres, lCompteur, 1) =

Chr(((((Asc(Mid(pChaine, lCompteur, 1)) + 224)- ((Asc(Mid(CLEF, (lCompteur Mod Len(CLEF)) + 1, 1)) * lLongueur) Mod 224)+32)-32) Mod 224)+32)
___________________________
NON, Ça ne fonctionne pas ....
Ça ne décode pas... Ça déconne plutôt... (Jeux de mots si vous permettez)

23h00 bientôt, je vais me coucher, demain travail...

_______________________________
NB j'ai testé le code du lien proposé par Arkham46 , mais ça ne me convient pas. 1) j'ai pas tout compris (ou rien compris), 2) je ne veux pas de caractères non imprimables (code ascii entre 1 et 31) car ils génèrent des erreurs au décryptage dans les cellules ou les contrôles de formulaires.
Le pire c'est que j'ai pas besoin de tout ça, c'est juste pour du codage en VBA...

[JMPS.VBA]

Code :

1
2
3
4
Const CLEF As String = "azerty uiop"
Const Itérations    As Variant = 1 'Nombre maximum d'itérations 256
Const Minor As Variant = 32 'Code du caractère ascii le plus bas dans la table
Const Major As Variant = 255 'Code du cactère ascii le plus haut dans la table

Code :

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
Dim Traitement As Variant 'Chaîne en cours de Traitement codage/décodage
Dim Position As Variant  ' Position en cours de Traitement
Dim LgChaîne As Variant 'Nombre de caractères dans la chaîne à crypter
Dim LgClef As Variant 'Nombre de caractères dans la clef
Dim CarChaîne As Variant 'caractère sélectionné dans la chaîne à crypter/décrypter
Dim CarClef As Variant 'caractère sélectioné dans  la clef
Dim Itération As Variant 'Compteur d'itération
Dim MajorB As Variant 'Redéfinit Major pour la plage en fonction de Minor
'Chaîne = Texte à crypter ou à décrypter
'Sens = True Crypter ou False Décrypter
 
'Définition de la LgChaîne de la chaîne à crypter et de la chaîne de résultat
MajorB = 1 + Major - Minor
LgClef = Len(CLEF)
LgChaîne = Len(Chaîne)
Traitement = String(LgChaîne, Chr(0))
 
    'Boucler en fonction du nombre de rotations attendues
    For Itération = 1 To Itérations
        For Position = 1 To LgChaîne
 
            'Recherche et met en phase les caractères en cours de la chaîne et de la clef
            CarChaîne = Asc(Mid(Chaîne, Position, 1))
            CarClef = Asc(Mid(CLEF, (Position Mod LgClef) + 1, 1)) '* LgChaîne
 
            Select Case Sens
            Case True: Mid(Traitement, Position, 1) = Chr(((CarChaîne + CarClef) Mod MajorB) + Minor)
            Case False: Mid(Traitement, Position, 1) = Chr((((CarChaîne + MajorB) - ((CarClef Mod MajorB) + Minor) - Minor) Mod MajorB) + Minor)
            Case Else: End Select
 
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        Chaîne = Traitement
    'Nouvelle itération
    Next
    'Renvoyer le résultat final
    CryptageVigenère = Traitement
End Function

Ça ne marche très bien que pour une seule itération.
après ça m'invente des caractère en dehors de la plage.
moi pas comprendre pourquoi ...
j'ai pensé que le type de données n'était pas adapté, j'ai tout passé en variant... mais non ... donc pas comprendre... et pourtant moi chercher beaucoup, lire beaucoup, etc... mais non moi pas comprendre pourquoi ça pas marcher après itération 1 ?

[JMPS.VBA]

J'arrête sur ce sujet.
J'ai trouvé ma solution pour crypter et décrypter le texte de cellules ou de contrôles de formulaires ou même des docs words... en supprimant du cryptage les codes de retour chariot, tabulation et autres (ceux dont la code ascii est inférieur à 32), et en les retrouvant après le décryptage afin de conserver la mise en page d'avant cryptage...
Au cryptage de vigenère, j'ajoute une confusion supplémentaire avec le cryptage de Freissner (seul, c'est très facile à casser, donc très peu d'intérêt)

La macro principale c'est SUB MAIN().

Code :

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
 
Const MASQUE As String = "933441295391989330356725734543502463" 'Masque de la feuille à trou de Freissner
Const Itérations    As Variant = 223 'Nombre maximum d'itérations majorB-1
Const Minor As Variant = 32 'Code du caractère ascii le plus bas dans la table
Const Major As Variant = 255 'Code du cactère ascii le plus haut dans la table
Dim CLEF As String 'Clef CryptageVigenère en variable pour contrôle de la plage des caratères
 
Sub MAIN()
Dim TEXTE1 As String
Dim TEXTE2 As String
 
TEXTE1 = InputBox("Taper votre texte ci-dessous :")
 
TEXTE2 = CRYPTAGE(TEXTE1, True)
MsgBox "Votre texte décrypté : " & Chr$(13) & TEXTE1 & Chr$(13) & Chr$(13) & "Cryptage : " & Chr$(13) & TEXTE2
 
TEXTE1 = CRYPTAGE(TEXTE2, False)
MsgBox "Votre texte crypté : " & Chr$(13) & TEXTE2 & Chr$(13) & Chr$(13) & "Décryptage : " & Chr$(13) & TEXTE1
End Sub
 
Function CRYPTAGE(ByVal Chaîne As String, ByVal Sens As Boolean)
'Controle Minor/Major
If Minor + Minor - 1 > Major Then MsgBox "Minor+Minor-1 > Major : Minor est trop élevé ou Major est trop bas"
If Major - (256 - Major) < Minor Then MsgBox "Major - (256 - Major) < Minor : Major est trop bas ou Minor est trop élevé"
 
'Clef pour CRyptage de Vigenère : Contrôle de la table ASCII utilisée pour la clef (Borne Minor et Major)
CLEF = "µÂ,^˜P§f>}¿!/Ð##„ø„˜�žcu‘’Ýj]e+0¦�Ùœåå ��°5ZJîñ…r3ß�/-9Ñt�fE‹›–Ð~¬há"
CLEF = Formatage(CLEF, True)
 
Select Case Sens
Case True: CRYPTAGE = CryptageFleissner(CryptageVigenère(Formatage(Chaîne, Sens), Sens), Sens)
Case False: CRYPTAGE = Formatage(CryptageVigenère(CryptageFleissner(Chaîne, Sens), Sens), Sens)
End Select
 
End Function
 
Public Function CryptageVigenère(ByVal Chaîne As String, ByVal Sens As Boolean)
Dim Traitement As Variant 'Chaîne en cours de Traitement codage/décodage
Dim Position As Variant  ' Position en cours de Traitement
Dim LgChaîne As Variant 'Nombre de caractères dans la chaîne à crypter
Dim LgClef As Variant 'Nombre de caractères dans la clef
Dim CarChaîne As Variant 'caractère sélectionné dans la chaîne à crypter/décrypter
Dim CarClef As Variant 'caractère sélectioné dans  la clef
Dim Itération As Variant 'Compteur d'itération
Dim MajorB As Variant 'Redéfinit Major pour la plage en fonction de Minor
'Chaîne = Texte à crypter ou à décrypter
'Sens = True Crypter ou False Décrypter
 
'Définition de la LgChaîne de la chaîne à crypter et de la chaîne de résultat
MajorB = 1 + Major - Minor
LgClef = Len(CLEF)
LgChaîne = Len(Chaîne)
Traitement = String(LgChaîne, Chr(0))
 
    'Boucler en fonction du nombre de rotations attendues
    For Itération = 1 To Itérations
        For Position = 1 To LgChaîne
 
            'Recherche et met en phase les caractères en cours de la chaîne et de la clef
            CarChaîne = Asc(Mid(Chaîne, Position, 1))
            CarClef = Asc(Mid(CLEF, (Position - (LgClef * Int(Position / LgClef))) + 1, 1))
 
            'Traitement de la chaîne en Cryptage/Déctyptage : substitution de caractères
            Select Case Sens
            Case True: Mid(Traitement, Position, 1) = Chr(((CarChaîne + CarClef) - MajorB * Int((CarChaîne + CarClef) / MajorB)) + Minor)
            Case False: Mid(Traitement, Position, 1) = Chr((((CarChaîne + MajorB) - (((CarClef - MajorB * Int(CarClef / MajorB)) + Minor)) - Minor) - MajorB * Int(((CarChaîne + MajorB) - (((CarClef - MajorB * Int(CarClef / MajorB)) + Minor)) - Minor) / MajorB)) + Minor)
            End Select
 
        Next
        'réaffecter la chaîne à crypter par le résultat trouvé pour pouvoir recommencer une itération
        Chaîne = Traitement
 
    'Nouvelle itération
    Next
 
    'Renvoyer le résultat final
    CryptageVigenère = Traitement
End Function
 
Function CryptageFleissner(ByVal Chaîne As String, ByVal Sens As Boolean)
Dim Traitement As Variant 'Chaîne en cours de Traitement
Dim Position As Variant ' Position en cours de Traitement
Dim LgChaîne As Variant 'Nombre de caractères dans la chaîne à crypter
Dim LgMasque As Variant 'Nombre de caractères dans la chaîne à crypter
Dim Itération As Variant 'Compteur d'itération
Dim CarChaîne As Variant
Dim CarMasque As Variant
'Chaîne = Texte à crypter ou à décrypter
'Sens = True Crypter ou False Décrypter
 
'Définition de la LgChaîne de la chaîne à crypter et de la chaîne de résultat
LgChaîne = Len(Chaîne)
LgMasque = Len(MASQUE)
 
'Supprime des caractères en début de chaîne en mode Décodage (Confusion)
If Sens = False Then Chaîne = Mid(Chaîne, Mid(MASQUE, 1, 1) + 1)
 
For Position = 1 To LgChaîne
 
CarChaîne = Mid(Chaîne, Position, 1)
 
    Select Case Sens
        Case True
            CarMasque = Mid(MASQUE, (Position Mod LgMasque + 1), 1)
            Traitement = Traitement & CarChaîne & CaractèresAléatoires(CarMasque)
        Case False
            Traitement = Traitement & CarChaîne
            Position = Position + Mid(MASQUE, (Len(Traitement) Mod LgMasque + 1), 1)
    End Select
Next
 
'Ajoute des caractères en début de chaîne en mode Codage (Confusion)
If Sens = True Then Traitement = CaractèresAléatoires(Mid(MASQUE, 1, 1)) & Traitement
 
CryptageFleissner = Traitement
End Function
Function CaractèresAléatoires(ByVal Nombre As Long) As String
Dim Répétition As Double
Dim TempString As String
 
For Répétition = 0 To Nombre - 1
TempString = TempString & Chr$(Int((Major - Minor + 1) * Rnd + Minor))
Next
CaractèresAléatoires = TempString
End Function
Function Formatage(ByVal Chaîne As String, ByVal Sens As Boolean)
'Remplace les caractères en dehors de la borne par des caractères dans la plage autorisée
Dim Itération As Double
Dim CodeSuite1 As Integer  'Code suite en position 1 remplaçant le caractère proscrit
Dim CodeSuite2 As Integer 'Code suite en position 2 remplaçant le caractère proscrit
Dim CodeSuite4 As Integer  'Code suite en position 4 remplaçant le caractère proscrit
Dim CarSuite1 As String 'Caractère suite en position 1 remplaçant le caractère proscrit
Dim CarSuite2 As String 'Caractère suite en position 2 remplaçant le caractère proscrit
Dim CarSuite4 As String 'Caractère suite en position 4 remplaçant le caractère proscrit
 
'Définition des variables
CodeSuite1 = Minor
CodeSuite2 = Int((Minor + Major) / 2)
CodeSuite4 = Major
CarSuite1 = Chr(CodeSuite1)
CarSuite2 = Chr(CodeSuite2)
CarSuite4 = Chr(CodeSuite4)
 
Do While Itération < Len(Chaîne)
    Itération = Itération + 1
        Select Case Sens
        Case True
        'Substitution des caractère sproscrits par une suite de caractères connus
                'Borne Inférieur
                If Asc(Mid(Chaîne, Itération, 1)) < Minor Then
                    Chaîne = Mid(Chaîne, 1, Itération - 1) & CarSuite1 & CarSuite2 & Chr(Asc(Mid(Chaîne, Itération, 1)) + Minor) & CarSuite4 & Mid(Chaîne, Itération + 1)
                    Itération = Itération + 3
                End If
 
                'Borne Supérieur
                If Asc(Mid(Chaîne, Itération, 1)) > Major Then
                    Chaîne = Mid(Chaîne, 1, Itération - 1) & CarSuite4 & CarSuite1 & Chr(Asc(Mid(Chaîne, Itération, 1)) - (255 - Major)) & CarSuite2 & Mid(Chaîne, Itération + 1)
                    Itération = Itération + 3
                End If
 
        Case False
        'Substitution d'une suite de caractères connus par des caractères proscrits
                If Itération + 3 > Len(Chaîne) Then Exit Do
 
                'Borne Inférieur
                If Asc(Mid(Chaîne, Itération, 1)) + Asc(Mid(Chaîne, Itération + 1, 1)) + Asc(Mid(Chaîne, Itération + 3, 1)) = (CodeSuite1 + CodeSuite2 + CodeSuite4) And _
                   (Asc(Mid(Chaîne, Itération + 2, 1)) - Minor >= 0 And Asc(Mid(Chaîne, Itération + 2, 1)) - Minor < Minor) Then
 
                    Chaîne = Mid(Chaîne, 1, Itération - 1) & Chr(Asc(Mid(Chaîne, Itération + 2, 1)) - Minor) & Mid(Chaîne, Itération + 4)
                End If
 
 
                'Borne supérieur
                If Asc(Mid(Chaîne, Itération, 1)) + Asc(Mid(Chaîne, Itération + 1, 1)) + Asc(Mid(Chaîne, Itération + 3, 1)) = (CodeSuite4 + CodeSuite1 + CodeSuite2) And _
                   (Asc(Mid(Chaîne, Itération + 2, 1)) + (255 - Major) >= Major And Asc(Mid(Chaîne, Itération + 2, 1)) + (255 - Major) < 256) Then
                    Chaîne = Mid(Chaîne, 1, Itération - 1) & Chr(Asc(Mid(Chaîne, Itération + 2, 1)) + (255 - Major)) & Mid(Chaîne, Itération + 4)
                End If
 
        End Select
Loop
 
Formatage = Chaîne
End Function