[OFFICE VBA] Ecrire une fonction de décryptage

[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 :

? 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

 
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 :

 
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:

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