Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

AJOUT DE CLÉS CRYPTÉES DANS LE REGISTRE


Information sur la source

Catégorie :Base de registre Niveau : Initié Date de création : 07/05/2002 Date de mise à jour : 18/09/2002 12:48:42 Vu : 3 469

Note :
Aucune note

Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

Description

code parfois bien utile quand il s'agit d'informations sensibles comme les mots de passes. Certains me diront que l'on peut supprimer les clés mais si on mettait les pwd dans un fichier ce serait aussi facile... Le cryptage en lui même n'est pas de moi : je ne sais plus de qui il est.
Code a mettre dans un module  
 

Source

  • Private Const SAppli = app.exename
  • Private Const SPass = "unzolipasswordlepluslongpossible..."
  • Public Sub SSavesetting(ByVal SSection As String, ByVal SClé As String, ByVal SValeur As String)
  • SValeur = Cryptage(SValeur, SPass)
  • SaveSetting SAppli, SSection, SClé, SValeur
  • Exit Sub
  • End Sub
  • Public Function SGetSetting(ByVal SGsection As String, ByVal SGclé As String) As String
  • Dim SGvaleur As String
  • On Error GoTo SGErreurs
  • SGvaleur = GetSetting(SAppli, SGsection, SGclé)
  • SGvaleur = Decryptage(SGvaleur, SPass)
  • If SGvaleur = "" Then
  • SGvaleur = "erreur2$$256"
  • End If
  • SGetSetting = SGvaleur
  • Exit Function
  • SGErreurs:
  • Debug.Print Err.Number & Err.Description
  • SGetSetting = "erreur2$$256"
  • End Function
  • Private Function Cryptage(Textnoncrypter As String, Motdepasse As String) As String
  • Dim a, b, Textcrypter, Incr, TeXtec, okm, z, w
  • z = 0
  • For Incr = 1 To Len(Textnoncrypter)
  • 'C'a, c pour effectuer le code suivant le nombre de
  • 'caractère ke contient le texte
  • TeXtec = Mid$(Textnoncrypter, Incr, 1)
  • 'Là, c pour lire le caractère du texte
  • a = Asc(TeXtec)
  • 'Je transforme le caractère alphabétique en
  • 'caractère ASCII
  • z = z + 1
  • If z > Len(Motdepasse) Then
  • z = 1
  • 'Kan le mot de passe a été lu, on recommence à
  • 'son premier caractère
  • End If
  • okm = Mid$(Motdepasse, z, 1)
  • 'On lit le caractère du mot de passe
  • b = Asc(okm)
  • 'On prend son code ASCII
  • w = a + b
  • 'On additionne le code ASCII du texte et du mot de passe
  • If w > 255 Then
  • w = w - 255
  • 'Au cas où l'addition dépasserai 255, on retire 255
  • End If
  • Textcrypter = Textcrypter + Chr(w)
  • 'On additionne les lettres cryptés ki sont
  • 'retransformées en caractère "lisible" mais crypté
  • Next Incr
  • 'on fait de même pour la lettre suivante du texte à crypter
  • Cryptage = Textcrypter
  • 'Et on affiche le texte crypté ki ne ve plus rien dire
  • End Function
  • 'Le décryptage est le même avec la démarche inverse
  • 'on part du texte crypté, on le transforme en ASCII
  • 'On enlève l'ASCII du mot de passe et on obtient
  • 'l'ASCII du texte décrypté kon rechange en caractère lisible.
  • Private Function Decryptage(Textcrypte As String, Motdepasse As String) As String
  • Dim a, b, Textdecrypter, Incr, TeXtec, okm, z, w
  • z = 0
  • For Incr = 1 To Len(Textcrypte)
  • TeXtec = Mid$(Textcrypte, Incr, 1)
  • a = Asc(TeXtec)
  • z = z + 1
  • If z > Len(Motdepasse) Then
  • z = 1
  • End If
  • okm = Mid$(Motdepasse, z, 1)
  • b = Asc(okm)
  • w = a - b
  • If w < 0 Then
  • w = w + 255
  • End If
  • Textdecrypter = Textdecrypter + Chr(w)
  • Next Incr
  • Decryptage = Textdecrypter
  • End Function
Private Const SAppli = app.exename
Private Const SPass = "unzolipasswordlepluslongpossible..."

Public Sub SSavesetting(ByVal SSection As String, ByVal SClé As String, ByVal SValeur As String)
SValeur = Cryptage(SValeur, SPass)
SaveSetting SAppli, SSection, SClé, SValeur
Exit Sub
End Sub
Public Function SGetSetting(ByVal SGsection As String, ByVal SGclé As String) As String
Dim SGvaleur As String
On Error GoTo SGErreurs
SGvaleur = GetSetting(SAppli, SGsection, SGclé)
SGvaleur = Decryptage(SGvaleur, SPass)
If SGvaleur = "" Then
SGvaleur = "erreur2$$256"
End If
SGetSetting = SGvaleur
Exit Function
SGErreurs:
Debug.Print Err.Number & Err.Description
SGetSetting = "erreur2$$256"
End Function
Private Function Cryptage(Textnoncrypter As String, Motdepasse As String) As String
    Dim a, b, Textcrypter, Incr, TeXtec, okm, z, w
    z = 0
    For Incr = 1 To Len(Textnoncrypter)
    'C'a, c pour effectuer le code suivant le nombre de
    'caractère ke contient le texte
        TeXtec = Mid$(Textnoncrypter, Incr, 1)
        'Là, c pour lire le caractère du texte
                a = Asc(TeXtec)
                'Je transforme le caractère alphabétique en
                'caractère ASCII
                z = z + 1
                    If z > Len(Motdepasse) Then
                    z = 1
                    'Kan le mot de passe a été lu, on recommence à
                    'son premier caractère
                    End If
                    
                okm = Mid$(Motdepasse, z, 1)
                'On lit le caractère du mot de passe
                b = Asc(okm)
                'On prend son code ASCII
                w = a + b
                'On additionne le code ASCII du texte et du mot de passe
                    If w > 255 Then
                    w = w - 255
                    'Au cas où l'addition dépasserai 255, on retire 255
                    End If
        Textcrypter = Textcrypter + Chr(w)
        'On additionne les lettres cryptés ki sont
        'retransformées en caractère "lisible" mais crypté
            Next Incr
            'on fait de même pour la lettre suivante du texte à crypter
    Cryptage = Textcrypter
    'Et on affiche le texte crypté ki ne ve plus rien dire
End Function

'Le décryptage est le même avec la démarche inverse
'on part du texte crypté, on le transforme en ASCII
'On enlève l'ASCII du mot de passe et on obtient
'l'ASCII du texte décrypté kon rechange en caractère lisible.
Private Function Decryptage(Textcrypte As String, Motdepasse As String) As String
    Dim a, b, Textdecrypter, Incr, TeXtec, okm, z, w
    z = 0
    For Incr = 1 To Len(Textcrypte)
        TeXtec = Mid$(Textcrypte, Incr, 1)
                a = Asc(TeXtec)
                z = z + 1
                    If z > Len(Motdepasse) Then
                    z = 1
                    End If
                okm = Mid$(Motdepasse, z, 1)
                b = Asc(okm)
                w = a - b
                    If w < 0 Then
                    w = w + 255
                    End If
        Textdecrypter = Textdecrypter + Chr(w)
            Next Incr
    Decryptage = Textdecrypter
End Function
   

Conclusion

NB: Pour des prog plus "secure" mieux vaux utiliser un cryptage plus puissant  
 

Commentaires et avis

signaler à un administrateur
Commentaire de Florent le 07/05/2002 21:38:36

Ca a l'air pas mal, mais le cryptage est un peu faible, c'est seulement du polyalphabétique, ca tient pas 10s face a un ordi puissant. A tout ceux qui veulent faire du cryptage, je conseille d'utiliser le cryptage RSA (utilisé par PGP), bien plus puissant.

signaler à un administrateur
Commentaire de shivan le 08/05/2002 09:57:15

c clair ke le rsa, c pas la meme chose... ca se pirate aussi, mais fo prevoir plus de litre de café avant d'y arriver !!!

signaler à un administrateur
Commentaire de ADN733R le 10/05/2002 12:06:45

c'est pour cela que j'ai mis une petite note....

signaler à un administrateur
Commentaire de pirate75000 le 16/09/2002 13:35:55

Quelqu'un pourrais me donner des infos sur le systeme RSA
Merci

Ajouter un commentaire



Nos sponsors

Sondage...

CalendriCode

Décembre 2008
LMMJVSD
1234567
891011121314
15161718192021
22232425262728
293031    

Consulter la suite du CalendriCode



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel BAÏSE, Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,265 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.