Accueil > > > AJOUT DE CLÉS CRYPTÉES DANS LE REGISTRE
AJOUT DE CLÉS CRYPTÉES DANS LE REGISTRE
Information sur la source
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
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
PB LORS DE L'INSTALLATION SHAREPOINT 2010.PB LORS DE L'INSTALLATION SHAREPOINT 2010. par Patrick Guimonet
Lors de l'installation de SharePoint 2010, j'ai rencontré un problème de plantage à l'étape 5 du configuration Wizard. Ca se termine sur cet écran : Et en analysant le fichier de journalisation, on remarque vers la fin des 15000 et quelques lign...
Cliquez pour lire la suite de l'article par Patrick Guimonet [WF4] AJOUTER DES CONTRAINTES à UNE ACTIVITé (2/2)[WF4] AJOUTER DES CONTRAINTES à UNE ACTIVITé (2/2) par JeremyJeanson
Après mon précédent article qui attaque les contraintes par la fasse Nord de l'Everest. passons à la seconde possibilité offerte par WF4 pour valider une activité : la metadata . Je vous en ai déjà toucher un ou deux mots. La metadata dans WF4 est un élém...
Cliquez pour lire la suite de l'article par JeremyJeanson [WF4] AJOUTER DES CONTRAINTES à UNE ACTIVITé (1/2)[WF4] AJOUTER DES CONTRAINTES à UNE ACTIVITé (1/2) par JeremyJeanson
De WF3 à WF4 pas mal de choses on été changées pour faciliter la vie des développeurs, mais certain points peuvent sembler obscures. comme les contraintes. Pour vous guider, je me lance dans une série de deux articles. Ils présenterons deux approches poss...
Cliquez pour lire la suite de l'article par JeremyJeanson [ASP.NET] NE PAS SE FAIRE AVOIR PAR IHTTPMODULE ET SA MéTHODE INIT()[ASP.NET] NE PAS SE FAIRE AVOIR PAR IHTTPMODULE ET SA MéTHODE INIT() par tja
Beaucoup de développeurs pensent que lorsqu'on créé et enregistre un IHttpModule, il n'en existe qu'une seule instance et la méthode Init() sera appelée qu'une fois.
C'est faux
Cela peut vraiment créer des bugs subtils dont en ne se rend pas compte ...
Cliquez pour lire la suite de l'article par tja [MSTD10] SHAREPOINT 2010 ET TEAM FOUNDATION SERVER[MSTD10] SHAREPOINT 2010 ET TEAM FOUNDATION SERVER par phil
Un post rapide pour vous informer de la disponibilité de la vidéo de ma présentation sur SharePoint 2010 & Team Foundation Server. http://www.microsoft.com/france/vision/mstechdays10/Webcast.aspx?EID=20215d48-02e3-4d43-8c36-e53505c3b316 Dans la ...
Cliquez pour lire la suite de l'article par phil
Logiciels
Xilisoft Convertisseur Vidéo Ultimate (5.1.39.0305)XILISOFT CONVERTISSEUR VIDéO ULTIMATE (5.1.39.0305)Xilisoft Convertisseur Vidéo Ultimate est un outil puissant de conversion vidéo, facile à utilise... Cliquez pour télécharger Xilisoft Convertisseur Vidéo Ultimate Xilisoft DVD Ripper Ultimate (5.0.64.0304)XILISOFT DVD RIPPER ULTIMATE (5.0.64.0304)Xilisoft DVD Ripper Ultimate est un logiciel excellent pour copier et convertir DVD vers presque ... Cliquez pour télécharger Xilisoft DVD Ripper Ultimate Rigs of Rods (63.3)RIGS OF RODS (63.3)c'est un jeu de multi-simulation camions,autobus voitures, avions, bateaux, hélicoptère avec défo... Cliquez pour télécharger Rigs of Rods Konvertor (4.00)KONVERTOR (4.00)Le logiciel est un gestionnaire multimedia affichant, jouant et convertissant plus de 2000 format... Cliquez pour télécharger Konvertor
|