Reprend le sujet traité par DarKeenu (cryptage-décryptage à l'aide d'une clé)
La différence est que le texte crypté ne contient que des majuscules et est donc facilement transmissible autrement que par fichier interposé. Autrement le texte contient des caractères ANSI non "exprimables" (exemple ANSI 129) ou des caractères difficles à frapper (ex ANSI 199)
Source / Exemple :
Public Clef As String 'variable contenant la clé de cryptage/décryptage
Private Const ALPHAB As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Public Win As String
Public Wout As String
'Fonction de cryptage
Function Crypter(Texte As String, KK As String)
Dim CrypT As String 'var contenant la chaine résultat
Dim PosT As Long 'var contenant la position dans le texte
Dim PosK As Integer 'var contenant position active dans la clef
Dim i1 As Long 'indice de boucle
Dim i2 As Long 'indice de boucle
Dim i3 As Long
Dim temp As Long 'var temporaire
Dim ResT As Integer
Dim ResK As Integer
Dim ResS As Integer
Dim ANSID(512) As String
Dim TT As String * 1
Dim TK As String * 1
Dim CT As String * 2
' Remplir ANSID
ALPHA = ALPHAB
i1 = 1
i2 = 1
While i1 < 27
While i2 < 27
ANSID(i3) = Mid(ALPHAB, i1, 1) + Mid(ALPHAB, i2, 1)
i2 = i2 + 1
i3 = i3 + 1
If i3 = 513 Then GoTo ansifin
Wend 'fin i2
i2 = 1
i1 = i1 + 1
Wend ' fin i1
ansifin:
PosT = 1
While Not Texte = ""
TT = Mid(Texte, 1, 1)
If Len(Texte) = 1 Then Texte = "" Else Texte = Mid(Texte, 2)
' Lettre da clé
PosK = PosT
If PosK > Len(KK) Then PosK = PosT Mod Len(KK)
If PosK = 0 Then PosK = Len(KK)
TK = Mid(KK, PosK, 1)
'Cryptage 1 caractère
ResT = Val(Asc(TT))
ResK = Val(Asc(TK))
'Trouver la lettre texte
ResS = ResT + ResK
CT = ANSID(ResS)
CrypT = CrypT + CT
PosT = PosT + 1
Wend
FNHome.TxTIn = ""
FNHome.TxTOut = CrypT
FNHome.Show
FNHome.Enabled = True
End Function
'Fonction de décryptage
Function Décrypter(Texte As String, KK As String)
Dim CrypT As String 'var contenant la chaine résultat
Dim PosT As Long 'var contenant la position dans le texte
Dim PosK As Integer 'var contenant position active dans la clef
Dim i1 As Long 'indice de boucle
Dim i2 As Long 'indice de boucle
Dim i3 As Long
Dim temp As Long 'var temporaire
Dim ResT As Integer
Dim ResK As Integer
Dim ResS As Integer
Dim ANSID(512) As String
Dim TTc As String * 2
Dim TK As String * 1
Dim CTc As String * 1
' Remplir ANSID
ALPHA = ALPHAB
i1 = 1
i2 = 1
While i1 < 27
While i2 < 27
ANSID(i3) = Mid(ALPHAB, i1, 1) + Mid(ALPHAB, i2, 1)
i2 = i2 + 1
i3 = i3 + 1
If i3 = 513 Then GoTo ansifin
Wend 'fin i2
i2 = 1
i1 = i1 + 1
Wend ' fin i1
ansifin:
PosT = 1
While Not Texte = ""
TTc = Mid(Texte, 1, 2)
If Len(Texte) = 2 Then Texte = "" Else Texte = Mid(Texte, 3)
' Lettre dans la clé
PosK = PosT
If PosK > Len(KK) Then PosK = PosT Mod Len(KK)
If PosK = 0 Then PosK = Len(KK)
TK = Mid(KK, PosK, 1)
ResK = Val(Asc(TK))
' Lecture table ANSI D pour trouver TT
i1 = 0
While i1 < 513
If ANSID(i1) = TTc Then GoTo ansiok
i1 = i1 + 1
Wend
ansiok:
ResS = i1
ResT = ResS - ResK
CTc = Chr(ResT)
CrypT = CrypT + CTc
PosT = PosT + 1
Wend
FNHome.TxTIn = ""
FNHome.TxTOut = CrypT
FNHome.Show
FNHome.Enabled = True
End Function
Conclusion :
Le projet dans le zip permet de tester . Fonctionnement intuitif et simple.
A priori le but n'est pas d'utiliser tel quel mais d'intégrer les routines là où vous en avez besoin.
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.