Clm's xor : cryptage de fichiers sans limite de taille

Soyez le premier à donner votre avis sur cette source.

Vue 3 590 fois - Téléchargée 776 fois

Description

Cette source vous permet de crypter n'importe quel fichier sans se préoccuper de sa taille (car je sais que certaines personnes ont rencontré ce problème) et elle utilise la méthode de cryptage XOR.

Evidemment, plus le fichier est volumineux, plus ça prend du temps...
Je vous invite donc à aller voir une source de cryptage de fichier que j'ai faite et que j'ai remise à jour car elle est vraiment performante.
Elle se trouve ici:
http://www.vbfrance.com/article.aspx?Val=4567

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_ym_trainz
Messages postés
162
Date d'inscription
vendredi 27 janvier 2006
Statut
Membre
Dernière intervention
21 avril 2015
-
Encore moi, Clementio !

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
cs_ym_trainz
Messages postés
162
Date d'inscription
vendredi 27 janvier 2006
Statut
Membre
Dernière intervention
21 avril 2015
-
Heu... j'ai encore optimisé : 3 secondes et demi (au lieu des 17 au départ) :

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.
cs_ym_trainz
Messages postés
162
Date d'inscription
vendredi 27 janvier 2006
Statut
Membre
Dernière intervention
21 avril 2015
-
et je dirais même plus, on peut encore gagner un chouilla avec

Put #2, , Chr$(bChaine(lCompteur2) Xor ascCrypt(lPos))

Ce qui évite le Cstr(chr()) puisque chr$ convertit en String
cs_ym_trainz
Messages postés
162
Date d'inscription
vendredi 27 janvier 2006
Statut
Membre
Dernière intervention
21 avril 2015
-
Bravo clementio !

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
cs_rocker
Messages postés
23
Date d'inscription
mardi 11 octobre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
-
Très très bien comme source. Manque seulement des commantaires :D

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.