begin process at 2012 02 12 04:20:11
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Base de registre

 > AJOUT DE CLÉS CRYPTÉES DANS LE REGISTRE

AJOUT DE CLÉS CRYPTÉES DANS LE REGISTRE


 Information sur la source

Note :
Aucune note
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 :4 361

Auteur : ADN733R

Ecrire un message privé
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  


 Sources du même auteur

Source avec Zip ZONE IP ENFIN [ACTIVEX]
Source avec Zip UN GÉNÉRATEUR DE DICTIONNAIRE[DEBUGÉE]
PLUS RAPIDE QUE LE TRI À BULLE, LE TRI PAR SELECTION
POSITIONNER LES MESSAGESBOX OÙ L'ON VEUT
Source avec Zip DESSIN (AVEC LA SOURIS)

 Sources de la même categorie

Source avec Zip Source avec une capture Source .NET (Dotnet) SHELLVIEW EN VB.NET par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) AJOUTER OU SUPPRIMER MENU CONTEXTUEL D'APPLICATION PAR CLIC ... par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) MODIFIER IMAGE COULEUR EN NOIR ET BLANC PAR CLIC DROIT par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) RENOMMER TOUS LES FICHIERS D'UN DOSSIER PAR CLIC DROIT par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) REDIMENSIONNER ET IMPRIMER FORMAT PHOTO (10X15) par Le Pivert

Commentaires et avis

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.

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

Commentaire de ADN733R le 10/05/2002 12:06:45

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

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

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), 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

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,484 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales