Crypter avec le chiffre des nihilistes russes

Soyez le premier à donner votre avis sur cette source.

Vue 8 926 fois - Téléchargée 436 fois

Télécharger le projet
Commenter

Description

ce chiffrement est une variante légerement compliqué d'un carré de Polybe
-on cree une premiere clé une matrice de 5x5 contenant un alphabet ordonnée ou desordonnée,
le W etant volontairement omis (dans notre cas Azerty..etc)
-on defini une deuxieme clé de 25 caractere maximum (biscotte) que l'on chiffre avec la matrice précédement rempli
-au message chiffé, on additionne lettre par lettre la clé 2 pour obtenir notre message chiffré

1 2 3 4 5
1 a z e r t
2 y u i o p
3 q s d f g
4 h j k l m
5 x c v b n

test :
message clair "le chiffre des nihilistes"
cle 2 : visualbasic

Message clair l e c h i f f r e d e s n i h i l i s t e s
Lettres chiffrées 44 13 52 41 23 34 34 14 13 33 13 32 55 23 41 23 44 23 32 15 13 32
Mot de passe (répété) 53 23 32 22 11 44 54 11 32 23 52 53 23 32 22 11 44 54 11 32 23 52
Message chiffré final 97 36 84 63 34 78 88 25 45 56 65 85 78 55 63 34 88 77 43 47 36 84

A savoir que chaque lettre doit avoir 2 chiffre, on soustrait donc 100 aux sommes comprises entre 100 et 110.
51+55 est donc égale à 06.

Source / Exemple : 


Dim choix As Boolean 'on crypte ou decrypte
Dim tcle(4, 4) As String 'matrice cle1
Dim tabcle2() As Integer 'tableau cle2
Dim tabcf() As String 'tableau message chiffré peut contenir des nombre ou des lettres

Private Sub verification(choix)
If Len(cle1.Text) <> 25 Then MsgBox "erreur, la cle 1 doit avoir 25 caractere", vbCritical, "erreur cle 1"
If Len(cle2.Text) > 25 Then MsgBox "erreur, la cle 2 doit avoir moins de 25 caractere", vbCritical, "erreur cle 2"
Select Case choix '(0 on decrypte, 1 on crypte)
    Case 0
        If messcrypt.Text = "" Then MsgBox "erreur, il n'y a rien a dechiffré ", vbCritical, "message=vide": mess.Text = ""
        
    Case 1
        If mess.Text = "" Then MsgBox "erreur, il n'y a rien a chiffré ", vbCritical, "message=vide": messcrypt.Text = ""
End Select
End Sub

Private Sub chiffre_Click()
Dim car As String

verification (1) 'verifie les regles pour le cryptage
tabc1.Text = ""
tabc2.Text = ""
messcrypt.Text = ""

'on ne traite pas les espaces
Dim message As String: message = Replace(mess.Text, " ", "")
'determine la longueur du message et de la cle 2
Dim lngmess As Integer: lngmess = Trim(Len(message))
Dim lngcle2 As Integer: lngcle2 = Trim(Len(cle2.Text))

'mise en condition de la premiere clé
tabc1.Text = traitecle1(cle1.Text)

'mise en condition de la seconde clé
'par rapport a la longeur du texte a crypter
tabc2.Text = Left(traitecle2(cle2.Text, lngmess), (lngcle2 * 3))

'//////////////on chiffre

ReDim tabcf(lngmess)
'chaque lettre est remplacer par les coordonnées i j de la matrice
For i = 1 To lngmess
    car = UCase(Mid(message, i, 1))
    tabcf(i - 1) = findchiffre(car)
Next i

'on addtionne ensuite le message chiffré avec le tableau
'chiffré de la 2ieme cle lettre par lettre (chiffré)
'pour chaque cas , si le resultat est superieur a 100 on enleve 100
Dim res As Integer
For i = 0 To UBound(tabcf) - 1
    res = CInt(tabcf(i)) + CInt(tabcle2(i))
    If res >= 100 Then res = res - 100
    If Len(LTrim(res)) = 1 Then
         messcrypt.Text = messcrypt.Text & "0" & res & " "
    Else
         messcrypt.Text = messcrypt.Text & res & " "
    End If
Next i

End Sub
Private Function traitecle1(cle1 As String) As String
'mise en condition de la premiere clé
'insere dans une matrice la cle 1
Dim p As Integer: p = 1
Dim sortie As String: sortie = ""

For i = 0 To 4
    For j = 0 To 4
        car = UCase(Mid(cle1, p, 1))
        tcle(i, j) = car
        sortie = sortie & car & "|" 'pour l'affichage sur la form
        p = p + 1
        Next j
    sortie = sortie & vbCrLf 'pour l'affichage sur la form
Next i

traitecle1 = sortie

End Function
Private Function traitecle2(cle2 As String, lng As Integer) As String
'mise en condition de la deuxieme clé
'chiffre la clé 2 avec la matrice de la cle1
'et la prolonge en la repetant jusqu'a atteindre la
'longueur du message a chiffré
ReDim tabcle2(lng)
Dim lngc2 As Integer: lngc2 = Len(cle2)
Dim sortie As String
Dim car As String

For i = 0 To UBound(tabcle2) - 1
    car = UCase(Mid(cle2, j + 1, 1))
    tabcle2(i) = findchiffre(car)
    j = j + 1
    If j = lngc2 Then j = 0
    sortie = sortie & " " & tabcle2(i)
Next i

traitecle2 = sortie
End Function
Private Sub dechiffre_Click()

verification (0) 'verifie les regles du decryptage
tabc1.Text = ""
tabc2.Text = ""
mess.Text = ""

'on ne traite pas les espaces
Dim message As String: message = messcrypt.Text
'determine la longueur du message et de la cle 2
Dim lngmess As Integer: lngmess = Trim(Len(message)) / 3 '2 chiffres vont donnée 1 caractere + 1 pour l'espace entre 2 chiffres
Dim lngcle2 As Integer: lngcle2 = Trim(Len(cle2.Text))

'mise en condition de la premiere clé
tabc1.Text = traitecle1(cle1.Text)

'mise en condition de la seconde clé
'par rapport a la longeur du texte a decrypter
tabc2.Text = Left(traitecle2(cle2.Text, lngmess), (lngcle2 * 3))

'//////////////on dechiffre
'ReDim tabcf(lngmess)
tabcf = Split(message, " ")

'pour dechiffrer il suffit de soustraire la chaine de la clé 2 a la chaine du message crypter
'ne pas oublier de rajouter 100 si le nombre commence par 0

Dim res As Integer
For i = 0 To UBound(tabcf) - 1
If Left(tabcf(i), 1) = 0 Then tabcf(i) = CInt(tabcf(i)) + 100
    res = tabcf(i) - tabcle2(i): If res = 0 Then Exit Sub
    'il nous suffit maintenant de retrouver la lettre correspondante au nombre
    y = CInt(Left(res, 1)) - 1
    x = CInt(Right(res, 1)) - 1
    mess.Text = mess.Text & tcle(y, x)
Next i

End Sub

'retourne les coordonnées ij d'une lettre sous forme d'un chiffre
Private Function findchiffre(car As String) As Integer
For i = 0 To 4
    For j = 0 To 4
       If tcle(i, j) = car Then findchiffre = (i + 1) & (j + 1)
    Next j
Next i
End Function

Private Sub Form_Load()
choix = 1
End Sub

Conclusion :


a vous de l'améliorer, pour qu'il traite les phrases contenant des , ' . etc..
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.

Du même auteur (tresorsdevie)