Petit problème de cryptage en vigenère

**DenisHen** · 20/03/2015, 10h47

Bonjour à tous,

Voilà, j’essaie de crypter des données (une suite de textes, dates, temps... séparés par "#". NB : mes textes peuvent contenir des "retour chariot") contenu dans un fichier TXT en une seule ligne. Je lis donc le contenu de mon fichier avec un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Line Input #1, chaine$

Je crypte mon fichier avec ce code trouvé sur le Net :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Public Function Crypt(ByVal strChaine As String, blnCryptage As Boolean) As String
'Utilisation:
'- Cryptage --> Crypt("Chaine a crypter", true)
'- Decryptage -->Crypt("Chaine a decrypter", false)
    Dim I As Integer, J As Integer, K As Integer
    Dim strCryptKey As String, strLettre As String, strKeyLettre As String
    Dim intLettre As Long, intKeyLettre As Long, strResultat As String
 
    If strChaine = "" Then
        Crypt = ""
        Exit Function
    End If
 
    strCryptKey = "Clé secondaire de cryptage"
 
    For K = 0 To 10 Step 1
        strResultat = ""
 
        For I = 1 To Len(strChaine) Step 1
            strLettre = Mid(strChaine, I, 1)
            J = I
            Do While J > Len(strCryptKey)
                J = J - Len(strCryptKey)
            Loop
            strKeyLettre = Mid(strCryptKey, J, 1)
            intLettre = Asc(strLettre)
            intKeyLettre = Asc(strKeyLettre)
 
            If blnCryptage = True Then
                intLettre = intLettre + (intKeyLettre * Len(strChaine))
            Else
                intLettre = intLettre - (intKeyLettre * Len(strChaine))
            End If
 
            Do While intLettre > 255
                intLettre = intLettre - 255
            Loop
            Do While intLettre < 0
                intLettre = intLettre + 255
            Loop
            strResultat = strResultat & Chr(intLettre)
        Next I
 
        strChaine = strResultat
    Next K
 
    Crypt = strResultat
End Function

Mais quand je relis ce fichier, avec un contenu crypté, je me suis aperçu qu'il contenait plusieurs lignes...

Je ne peut plus le lire avec un "Line Input"... Le décryptage ne se fait pas correctement.

Quelqu'un aurait-il une solution à mon problème ou, comment lire l'intégralité d'un fichier en une seule variable (chaine$) ?

Bonne journée à tous...

Denis...

Invité · 20/03/2015, 11h01

Bonjour,
dans l'exemple suivant, tu ouvre tout ton fichier en une seule action et tu place le resultat dans txt.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Set FSO = CreateObject("Scripting.FileSystemObject")
if  FSO.GetFile(Fichier).Size= 0 then exit sub
Set oTxt = FSO.OpenTextFile(Fichier, 1)
txt = oTxt.ReadAll
oTxt.Close
Set oTxt = Nothing
set FSO =nothing

**DenisHen** · 20/03/2015, 11h21

Bonjour rdurupt et merci pour ta réponse,

Le fichier se lit impeccablement bien... Mais il ne me le décrypte pas correctement. Je pense que je devrais utilisé "Scripting.FileSystemObject" pour écrire ce même fichier...

Mais [F1] sur "FileSystemObject" ou sur "OpenTextFile" me donne dans les deux cas : "Mot clé introuvable, Office Shared [vblr6.chm1009553]".

Pour écrire dans ce fichier text, puis-je faire çà ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
            Set oTxt = oFso.OpenTextFile(fichier, 1)
            oTxt.Write="Texte à écrire"
            oTxt.Close

Et encore merci de m'aider...

Denis...

Invité · 20/03/2015, 11h38

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set fso = nothing
Set NewFichier = nothing

ceci dit vérifies ta méthode de cryptage selon la taille du texte ça part en vrille il en existe de plus ou mois fiable!

**DenisHen** · 20/03/2015, 11h44

Merci rudupt pour ton aide, juste deux petites questions :

-le "2" veux dire quoi ? c'est son emplacement mémoire ?

- le "True" veut dire quoi ? Qu'il créé le fichier s'il n'existe pas ou l'écrase ou un truc dans ce genre ?

Je n'ai pas trouvé de tuto ni de FAQ concernant ce sujet...

Denis...

Invité · 20/03/2015, 13h20

le true force les drois!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set NewFichier = fso.OpenTextFile(Fichier, 1, True) 'Lecture
Set NewFichier = fso.OpenTextFile(Fichier, 2, True) 'Création de fichier Creat
Set NewFichier = fso.OpenTextFile(Fichier, 8, True) 'Ajouter du text dans un fichier existant Append

https://msdn.microsoft.com/fr-fr/lib...(v=vs.71).aspx

**kiki29** · 20/03/2015, 13h31

Salut, à voir : Une petite fonction de cryptage en VBA ( pas testé )

**DenisHen** · 20/03/2015, 13h58

Bonjour à tous,

Merci pour vos remarques et aides...

Je potasse ça ce week-end, doucement...

Je pense en fait qu'il doit il y avoir une coquille dans les codes... Il doit il y avoir une différence quelque-part entre le cryptage, l'écriture, la lecture et le décryptage...

Une coquille a dû se glisser entre ces quatre étapes...

kiki29 : comment utilise-t-on ce code pour décrypter ?

Merci encore à vous deux...

Bon week-end à tous...

Denis...

**kiki29** · 20/03/2015, 14h16

Salut, une recherche t'aurait mené ici ( pas testé non plus )

Invité · 20/03/2015, 15h10

là tu choisis ta clé de cryptage
Sub test()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub test()
Const txt = "1234567890°+&é""'(-è_à)=~#{[|\^@]} " & vbCrLf & "azertyuiop^¨$£qsdghjklmù%*µ<>wxcvbn,?;.:/!§"
Const cle = "cheval"
Debug.Print DeCrypt(Crypt(txt, cle), cle)
End Sub
 
Function Crypt(T As String, cle As String) As String
Dim I As Long
Dim P As Long
Dim oF As Long
Crypt = ""
P = 1
For I = 1 To Len(T)
    oF = (Asc(Mid(T, I, 1)) - Asc(Mid(cle, P, 1)))
    If oF < 0 Then oF = 255 + oF
    Crypt = Crypt & Chr(oF)
    P = P + 1: If Len(cle) < P Then P = 1
Next
End Function
 
 
 Function DeCrypt(T As String, cle As String) As String
Dim I As Long
Dim P As Long
Dim oF As Long
DeCrypt = ""
P = 1
For I = 1 To Len(T)
    oF = (Asc(Mid(T, I, 1)) + Asc(Mid(cle, P, 1))) - 255
    If oF < 0 Then oF = oF + 255
    P = P + 1: If Len(cle) < P Then P = 1
    DeCrypt = DeCrypt & Chr(oF)
Next
End Function

**Zirak** · 20/03/2015, 15h25

Envoyé par kiki29

Salut, à voir : Une petite fonction de cryptage en VBA ( pas testé )

Je confirme que la fonction ci-dessus fonctionne très bien (je m'en sers tous les jours) pour une chaîne alphanumérique "courte".

Maintenant pour un texte entier avec retour chariot et autres, je ne suis pas certain (voir à ce propos la fin de la discussion du lien de kiki29 sur la fonction de décryptage)

**DenisHen** · 20/03/2015, 15h29

Merci kiki29,

J'avais déjà vu mais je n'avais pas fait le rapprochement entre le cryptage et le décryptage...

Je pensais plus à un module traitant les deux opérations à la fois, comme dans le code que j'ai poster ou il faut une seule ligne de commande, avec une petite différence (True et False), pour les deux opération, comme :

'- Cryptage --> Crypt("Chaine a crypter", True)
'- Decryptage -->Crypt("Chaine a décrypter", False)

Car pour moi, enfin on me l'impose => sécurité GoogleDrive oblige, à crypter toutes les données transitant par GoogleDrive...

Voilà, je pense avoir tout dis, sinon, qu'après tout-ça, je vais devoir me pencher sur l'envoi de ces données à notre serveur FTP, car si je crypte, c'est parce que nos différentes agences réparties dans la France entière, utiliseront le même fichier XLSM que je suis en train de développer ! ! ! (C'est pour moi un exploit que je réalise car, aux vues de vos remarques et observations dans les différents fils de ce site que je lis assidument, je resterais toujours un "novice") je dois, en plus imaginer l’interaction entre les fichiers ... POUF ! ! ! Je me disperse... Je résume... :
La maison mère dans laquelle je travaille VEUT uniformiser le traitement des dossiers de chaque agences en France (je présume que c'est pour en garder un contrôle "simplifié", planification, budget, rendement...). J'ai donc fais un Xlsm qui traite et répertorie les différents dossiers de nos agences en France (toutes n'ont pas les mêmes données).
Je fais donc un travail de surface (agence par agence) qui gère les dossiers... Et en même temps, je dois faire un travail de fond qui gère TOUS les différents dossiers de toutes nos agences...

Je m'en sortirais certainement avec ce forum, car il est d'une utilité ! ! ! Vous n'avez pas idée, vous les "pros"... De ce que nous apporte les conseilles que vous distiller de temps à autre, croyant cité une chose anodine, mais qui pour les novices, donne réellement du "fil à retordre"...

Pour faire encore plus simple, on me demande de faire un ERP mais sans le faire... (oui, moi aussi j'ai rigolé... Au début...)

J'ai franchement besoin d'aide... Car celà me dépasse de loin ! ! ! Mais grâce à ce site, je m'en sors à chaque fois ! ! ! Et je trouverais la solution...

Je vous dévoile mes secrets uniquement pour obtenir une "aide" de quelqu'un qui aurait résolu le problème et qui pourrait m'en faire profité...

Si les grands de ce Forum se sont perdus dans mes lignes...Je résume :

Je travaille pour une boite qui a des agences partout en France,
- Personne ne travaille comme les autres,
- Toutes les agences ont leurs "propres champs" pour la gestion (ex, l'agence de Troyes ne gère pas le bugjet du client, alors que l'agence du Limousin le fait ! !)
- Toutes les agences ne gère pas leurs comptes comme la maison mère (normale, à la maison mère, c'est la Compta qui gère les "tunes", dans les agences, ben c'est elles qui le gère...)
En bref, j'aurais des Xlsm partout pour que, à la maison mère, on puisse géré et surtout, budgéter le planning des agences...

Invité · 20/03/2015, 15h35

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub test()
Const txt = "1234567890°+&é""'(-è_à)=~#{[|\^@]} " & vbCrLf & "azertyuiop^¨$£qsdghjklmù%*µ<>wxcvbn,?;.:/!§"
Const cle = "cheval"
Debug.Print Crypt(Crypt(txt, cle, False), cle, True)
End Sub
 
Function Crypt(T As String, cle As String, DeCrypter As Boolean) As String
If DeCrypter = True Then Crypt = DeCrypt(T, cle): Exit Function
Dim I As Long
Dim P As Long
Dim oF As Long
Crypt = ""
P = 1
For I = 1 To Len(T)
    oF = (Asc(Mid(T, I, 1)) - Asc(Mid(cle, P, 1)))
    If oF < 0 Then oF = 255 + oF
    Crypt = Crypt & Chr(oF)
    P = P + 1: If Len(cle) < P Then P = 1
Next
End Function
 
 
Function DeCrypt(T As String, cle As String) As String
Dim I As Long
Dim P As Long
Dim oF As Long
DeCrypt = ""
P = 1
For I = 1 To Len(T)
    oF = (Asc(Mid(T, I, 1)) + Asc(Mid(cle, P, 1))) - 255
    If oF < 0 Then oF = oF + 255
    P = P + 1: If Len(cle) < P Then P = 1
    DeCrypt = DeCrypt & Chr(oF)
Next
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub test()
Const txt = "1234567890°+&é""'(-è_à)=~#{[|\^@]} " & vbCrLf & "azertyuiop^¨$£qsdghjklmù%*µ<>wxcvbn,?;.:/!§"
Const cle = "cheval"
Debug.Print CryptDeCrypt(CryptDeCrypt(txt, cle, False), cle, True)
End Sub
 
Function CryptDeCrypt(T As String, cle As String, DeCrypter As Boolean) As String
Dim I As Long
Dim P As Long
Dim oF As Long
CryptDeCrypt = ""
Debug.Print T
P = 1
For I = 1 To Len(T)
 
   If DeCrypter = False Then oF = (Asc(Mid(T, I, 1)) - Asc(Mid(cle, P, 1))) Else oF = (Asc(Mid(T, I, 1)) + Asc(Mid(cle, P, 1))) - 255
   If oF < 0 Then oF = 255 + oF
    CryptDeCrypt = CryptDeCrypt & Chr(oF)
    P = P + 1: If Len(cle) < P Then P = 1
Next
End Function

**Marc-L** · 20/03/2015, 16h14

Bonjour.

Envoyé par DenHen

Je pensais plus à un module traitant les deux opérations à la fois

C'est possible avec ~~un module~~ une fonction de cryptage simpliste …

Sinon rien qu'en lisant le tutoriel …

__________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

**DenisHen** · 20/03/2015, 16h39

Lequel Marc-L, Car moi, je n'ai pas trouvé... Peut-être trop... Bête... Non ?

Quel tutoriel ?

Mais "putaint" ! ! " Je rame... Je bosse même les week-end ! ! ! C'est pour dire si ce truc me tiens à cœur...

Denis

Invité · 20/03/2015, 16h45

Dans mon dernier post je t'ai mis une fonction qui crypte et décrypte avec un true/false!

Pour te dire il n'y a pas que les putains qui rame pour te sortir de cette galère!

Edit:
Allié je tente une autre approche!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test()
Const txt = "1234567890°+&é""'(-è_à)=~#{[|\^@]} " & vbCrLf & "azertyuiop^¨$£qsdghjklmù%*µ<>wxcvbn,?;.:/!§"
Const cle = "cheval"
Dim txtCrypte as string,txtDeCrypte as string
txtCrypte= CryptDeCrypt(txt, cle, False)
 
txtDeCrypte = CryptDeCrypt(txtCrypte, True)
End Sub
 
Function CryptDeCrypt(T As String, cle As String, DeCrypter As Boolean) As String
Dim I As Long
Dim P As Long
Dim oF As Long
CryptDeCrypt = ""
Debug.Print T
P = 1
For I = 1 To Len(T)
 
   If DeCrypter = False Then oF = (Asc(Mid(T, I, 1)) - Asc(Mid(cle, P, 1))) Else oF = (Asc(Mid(T, I, 1)) + Asc(Mid(cle, P, 1))) - 255
   If oF < 0 Then oF = 255 + oF
    CryptDeCrypt = CryptDeCrypt & Chr(oF)
    P = P + 1: If Len(cle) < P Then P = 1
Next
End Function

**DenisHen** · 20/03/2015, 19h20

Bonsoir et merci à tous de vous pencher sur mon problème...

Rudupt, tu codes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
txtDeCrypte = CryptDeCrypt(txtCrypte, True)
... 
Function CryptDeCrypt(T As String, cle As String, DeCrypter As Boolean) As String

Tu passes deux variables dans txtDeCrypt(txtCrypte, True) et la Fonction CryptDeCrypt en demande trois...

Je ne sais pas comment m'en sortir...

Tu aurais des "explications" à me fournir s'il te plait ? Merci en tout cas pour votre aide...

Mais j'en reviens à mon "cryptage", est-ce bien raisonnable ou sensé, d'utilisé Vigenère pour le cryptage d'un fichier ne contenant qu'une seule ligne... ? Je me pose la question... Et vous ?

Mais bon, pensez à vous et profitez de votre week-end... On se retrouve lundi, si vous le voulez bien...

Denis...

Invité · 20/03/2015, 20h22

Désolé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
txtCrypte= CryptDeCrypt(txt, cle, False)
 
txtDeCrypte = CryptDeCrypt(txtCrypte,cle, true)

**kiki29** · 21/03/2015, 00h14

Salut, tu peux aussi ( si tu veux voir d'autres méthodes de cryptage ) aller ici.

**DenisHen** · 23/03/2015, 09h34

Bonjour à tous,

Et encore merci de m'aider dans mon problème...

Rudupt : j'ai une petite différence entre le cryptage/décryptage, en effet, j'ai en première ligne à crypter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
1#ALSACE - FRANCHE CONTÉ#Lot inconnu#STEIGE#HOUTMANN#1061836 CTRL04#D323-061025#02/12/2014#02/12/2014#Denis H.#14/01/2015#Jérome M.###19/01/2015#James M.#Archivé#####200#160###8.33333333333333E-02##4.16666666666667E-02#Jérome M.#13/01/2015#16/01/2015#Kingersheim#67477#67220#589#Détection de contrôle.
Ne pas faire de fond de plan#19/01/2015#186,69#James M.#

Ce qui me donne une fois crypté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

•ˆ¯µÆo«ªŽ›•¿·³Ž¦*·…±´|º<‡±ÝÝ“—ÖÈÝÜãîˆÅ”¨®¹ª‘*}»Æ±¦¼·–_˜›Ÿ¦¨¯…µ”µ±¢™‘©a˜¥‘•¤š£`ˆž*¤ª—¡r“–¦ˆž—]—¤“—žš§Q¬ÊÜ×è™**c”™¡•Ÿ”`–£™ˆ¸SåÕÊŽ»£œˆ•qœ”¢–—^—§‡¯ÏÖØ¡ˆ²œ‘¶ëÈÚ©ÙO•ˆ‘ˆQ˜¢”ˆŸŸ£Q‹ˆ¦œ¨¬˜¥s–˜¥˜¡˜a™¥©’ž›–Qœ“Ÿ¤«¯›¨v™›¨›¤›e«Ÿ”—‘³]*×ÒÓŽÂ§ˆ£s’•£”*•_›••›™¤]š•Ÿ£˜ÄÎà§È×åÍÓÎ›‰¨›™¥*–dŸ—*ž˜®«c§OæÊÑÙ—Õà„ÉÓ‰ÖÖÙàcáÞ“|ŽÈ…âÆá…”ÇÛÖÊŽÍØNÎÔÜÒ•ÝÊ’°ÏÆàˆŸž]–£“—žš¨Q™¤š«²ˆ¼¡ÐÊå…»“Q

Et me renvois quand je le décrypte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
1#ALSACE - FRANCHI ?ONTÉ#Lot inconnu#STEIKEHOUTMANN#1061836 CTRL44D323-061025#02/12/2018#,2/12/2014#Denis H.#1430-/2015#Jérome M.###19/41+2015#James M.#Archivé'###200#160###8.333333373/3333E-02##4.166666666:6267E-02#Jérome M.#13/05/.015#16/01/2015#Kingerwhaim#67477#67220#589#Déxe_tion de contrôle.
Ne tao faire de fond de plar#-9/01/2015#186,69#Jamew I.#

J'ai bien la même clé dans les deux cas... Je ne comprend pas, mais je cherche...

Kiki29 : merci pour ton lien, mais mon antivirus au boulo me dit qu'il y a un virus et ne me le télécharge pas...

Merci encore à vous...

Denis...

Petit problème de cryptage en vigenère [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager