CLM'S XOR : CRYPTAGE DE FICHIERS SANS LIMITE DE TAILLE
cs_LordBob
Messages postés
2865
Date d'inscription
samedi 2 novembre 2002
Statut
Membre
Dernière intervention
11 mai 2009
-
20 janv. 2003 à 20:12
cs_ym_trainz Messages postés 160 Date d'inscription vendredi 27 janvier 2006 Statut Membre Dernière intervention 21 avril 2015 - 18 déc. 2007 à 22:37
cs_ym_trainz Messages postés 160 Date d'inscription vendredi 27 janvier 2006 Statut Membre Dernière intervention 21 avril 2015 - 18 déc. 2007 à 22:37
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/5719-clm-s-xor-cryptage-de-fichiers-sans-limite-de-taille
https://codes-sources.commentcamarche.net/source/5719-clm-s-xor-cryptage-de-fichiers-sans-limite-de-taille
18 déc. 2007 à 22:37
En partant donc de ton code, j'ai réussi à encoder 1 Mo en 0,8 secondes !
L'idée c'est de passer par un tableau byte (2 bytes par charactère ascii)
Exemple : si Chaine = "AB"
Tu fais dim Tableau() as byte : redim tableau (len(chaine)*2-1) car de 0 à deux fois la longueur...
Ensuite,
Tableau = chaine ou inversement, et voilà ! Il n'y a plus qu'à faire du Xor octet par octet
Je mets la fonction ci-dessous si ça peut intéresser quelqu'un...
Attention, il faut utiliser la méthode fichier for Binary si on veut exploiter lecture/ ecriture de fichier(genre open path for binary as #n : get #n,,Chaine ou put #...) car les caractères obtenus ne passent plus avec print # ou input #
Le code :
-----------------------------
'Option Explicit
Public Function CrypterDecrypterChaine(StringToCrypt As String, _
CleCryptage As String) As String
'encode ou decode StringToCrypt selon la clé de cryptage CleCryptage
'modif ym_trainz 12/2007
If StringToCrypt = "" Then
'rien à coder
CrypterDecrypterChaine = ""
Exit Function
End If
Dim i As Long, LenToCrypt As Long
Dim Source() As Byte, Destination() As Byte 'le tableau source et destination
Dim ascCrypt() As Byte, LenCle As Long, lPos As Long
'
LenCle = Len(CleCryptage) 'longueur de la clé de cryptage
LenToCrypt = Len(StringToCrypt) * 2 - 1 'ascii sur 2 octets
ReDim ascCrypt(LenCle) 'ascCrypt(0) est inutilisé
ReDim Source(LenToCrypt)
ReDim Destination(LenToCrypt)
Source = StringToCrypt
'
For i = 1 To LenCle
ascCrypt(i) = Asc(Mid(CleCryptage, i)) 'mise en mémoire de la clé en ascii
Next i
'
lPos = 0 'position dans la clé
Dim C As Long
For i = 0 To LenToCrypt
C = i Mod 2048 'toutes les 2048 fois (1 Ko)
'a la place du debug.print, on peut gérer une ProgressBar
If C = 0 Then Debug.Print Int(CDbl(i / CDbl(Len(StringToCrypt))) * 50): DoEvents
lPos = lPos + 1
If lPos > LenCle Then lPos = 1
Destination(i) = Source(i) Xor ascCrypt(lPos) 'codage Xor
Next i
CrypterDecrypterChaine = Destination 'copie directe !!!
End Function
----------------------------------------------
Cordialement,
ym_trainz
16 déc. 2007 à 23:21
Calculer et mettre en constante Len(Text1.Text) :
Dim LenText As Long
LenText = Len(Text1.Text)
ReDim ascCrypt(LenText) 'ascCrypt(0) est inutilisé
For i = 1 To LenText
ascCrypt(i) = Asc(Mid(Text1.Text, i))
Next i
...
For lCompteur2 = 0 To UBound(bChaine) - 1
If lPos < LenText Then 'et non len(Text1.text)
...
Bon...Merci encore, je vais me servir de ton code.
16 déc. 2007 à 22:31
Put #2, , Chr$(bChaine(lCompteur2) Xor ascCrypt(lPos))
Ce qui évite le Cstr(chr()) puisque chr$ convertit en String
16 déc. 2007 à 22:25
J'ai trouvé une amélioration possible qui fait gagner en vitesse.
J'ai crypté (ou décrypté, c'est idem, nomal ;-) un fichier de 1,39 Mo en 17 secondes.
Avec ma bidouille, je n'ai mis que 10 secondes. Soit 1,6 fois plus vite :
Calculer les codes ascii de la clé une fois pour toute dans un tableau :
Dans Private Sub CPartiMonKiki(), ajouter :
Dim i As Long
Dim ascCrypt() As Byte 'en long, ça va même un poil plus vite
ReDim ascCrypt(Len(Text1.Text)) 'ascCrypt(0) est inutilisé
'on sauvegarde une fois pour toutes dans le tableau
For i = 1 To Len(Text1.Text)
ascCrypt(i) = Asc(Mid(Text1.Text, i))
Next i
...
' remplacer Put #2, , CStr(Chr(bChaine(lCompteur2) Xor Asc(Mid(Text1, lPos, 1)))) par
Put #2, , CStr(Chr(bChaine(lCompteur2) Xor ascCrypt(lPos)))
Bon, je suppose que tu y avais pensé...
En tous cas, bravo ! Simple et efficace.
10/10
Cordialement,
ym_trainz
18 mars 2007 à 18:15
23 oct. 2006 à 04:32
Très bonne source,
ça fait plaisir de voir qu'il y a enfin des gens qui s'intéressent au traitement des gros fichiers.
Il manque juste des "DoEvents" ou "Sleep" pour éviter de bouffer toute les ressources systèmes, puis une mise en forme du code (module ou classe) et des commentaires !
30 avril 2004 à 21:47
21 janv. 2003 à 01:23
20 janv. 2003 à 21:16
20 janv. 2003 à 20:27
Dim Datas() as Byte
Redim Datas(LOF(1)-1)
Get #1,,Datas
Puis traiter des byte au lieu de charactere tu gagnerais un temp non negligeable sur les gros fichiers et mem sur les petits et rajoute aussi une barre de progression avec un timer du genre si le temp ecouler est superieur 2 deux seconde la barre apparait !!
(A quand le CLM'VB ?)
Voila @+ clementio
20 janv. 2003 à 20:12