Et bien voici mon 1er source, certe trés simple, mais le but été pour moi de comprendre, J'espère que certain d'entre vous y trouveront des améliorations.
Si vous avez des questions n'hésitez pas.
Source / Exemple :
Private Sub Commande12_Click()
'**********************decryptage clé fixe***********************
Dim i, chainecrypt, chainedecrypt, decrypt, cpt
cpt = 0
For i = 1 To Len(cryptf) Step 3
cpt = cpt + 1
chainecrypt = Mid(cryptf, i, 3)
chainedecrypt = (chainecrypt Xor Asc(Mid(cle, cpt, 1)))
decrypt = decrypt & Chr(chainedecrypt)
Next i
Texte10 = decrypt
End Sub
Private Sub Commande9_Click()
'********************cryptage avec xor et clé fixe***************
Dim inptext, char, longtext, i, c, j, val_max, var_cle
Dim nmbr As Integer
Dim var_char, val_debut_cle As String
cle = "abc"
inptext = InputBox("entrez le text a crypter")
longtext = Len(inptext)
val_debut_cle = cle
'--egalisation de la longueur de la clé et celle des données--
val_max = Int(((longtext / Len(val_debut_cle)) - 1))
For c = 1 To val_max
cle = cle & val_debut_cle
Next c
j = longtext - Len(cle)
cle = cle & Left(cle, j)
'---------------------fin de l'égalisation--------------------
For i = 1 To longtext
var_char = Mid(inptext, i, 1)
var_cle = Asc(Mid(cle, i, 1))
char = Asc(var_char)
crypt = (var_cle Xor char)
If Len(crypt) < 2 Then 'ajout de 0 pour combler les vides
crypt = "0" & crypt
End If
If Len(crypt) < 3 Then
crypt = "0" & crypt
End If
If Not i = 1 Then
cryptf = cryptf & crypt
Else
cryptf = crypt
End If
Next i
MsgBox ("Cryptage = " & cryptf)
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.