Crypter-décrypter un texte - texte crypté uniquement en majuscules - v2

Télécharger le projet
Commenter

Description

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.