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
SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko
Logiciels
Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|