Ce code peut crypter et décrypter tous type de fichiers sans les endommager avec une vitesse>210 ko/s

5/5 (6 avis)

Snippet vu 15 312 fois - Téléchargée 29 fois

Contenu du snippet

Ce code peut crypter et décrypter tous type de fichiers sans les endommager avec une vitesse>210 Ko/s

Source / Exemple :


Sub encrypt(filename, outputfilename, pourcentage As Label, speed As Long)
If speed < 0 Or speed > 10 Then MsgBox " Speed doit être compris entre 0 et 10": Exit Sub
If speed <> Int(speed) Then MsgBox "Speed doit être un entier": Exit Sub
speed = speed * 15
If speed = 0 Then speed = 1
w = Timer
Set fs = CreateObject("scripting.filesystemobject")
Set r = fs.getfile(filename)
Set u = fs.createtextfile(outputfilename)
Set g = r.openastextstream(1)
c = -1
rsize = r.Size
qa = Int(4096 / speed)
On Error Resume Next
For t = 1 To Int(rsize / speed)
c = c + 1
m = g.read(speed)
ff = ""
For tt = 1 To speed
ff = ff & Chr(Asc(Mid(m, tt, 1)) - 1)
If Len(ff) <> tt Then ff = ff & Chr(255)
Next tt
u.write ff
If c = qa Then c = 0: pourcentage.Caption = FormatNumber((t / rsize) * 100 * speed, 0) & "%": DoEvents
Next t
m = g.read(rsize - ((t - 1) * speed))
ff = ""
For tt = 1 To Len(m)
ff = ff & Chr(Asc(Mid(m, tt, 1)) - 1)
If Len(ff) <> tt Then ff = ff & Chr(255)
Next tt
u.write ff
g.Close
u.Close
sx = FormatNumber((rSize / 1024) / (Timer - w), 1) & " Ko par secondes"
pourcentage.Caption = "Terminé " & sx
End Sub

Sub decrypt(encryptedfilename, outputfilename, pourcentage As Label, speed As Long)
If speed < 0 Or speed > 10 Then MsgBox " Speed doit être compris entre 0 et 10": Exit Sub
If speed <> Int(speed) Then MsgBox "Speed doit être un entier": Exit Sub
speed = speed * 15
If speed = 0 Then speed = 1
w = Timer
Set fs = CreateObject("scripting.filesystemobject")
Set r = fs.getfile(encryptedfilename)
Set u = fs.createtextfile(outputfilename)
Set g = r.openastextstream(1)
c = -1
On Error Resume Next
rsize = r.Size
qa = Int(4096 / speed)
For t = 1 To Int(r.Size / speed)
c = c + 1
m = g.read(speed)
ff = ""
For tt = 1 To speed
ff = ff & Chr(Asc(Mid(m, tt, 1)) + 1)
If Len(ff) <> tt Then ff = ff & Chr(0)
Next tt
u.write ff
If c = qa Then c = 0: pourcentage.Caption = FormatNumber((t / rsize) * 100 * speed, 0) & "%": DoEvents
Next t
m = g.read(rsize - ((t - 1) * speed))
ff = ""
For tt = 1 To Len(m)
ff = ff & Chr(Asc(Mid(m, tt, 1)) + 1)
If Len(ff) <> tt Then ff = ff & Chr(0)
Next tt
u.write ff
u.Close
g.Close
sx = FormatNumber((rSize / 1024) / (Timer - w), 1) & " Ko par secondes"
pourcentage.Caption = "Terminé " & sx
End Sub

A voir également

Ajouter un commentaire

Commentaires

celiphane
Messages postés
466
Date d'inscription
samedi 16 février 2002
Statut
Membre
Dernière intervention
20 avril 2007
-
Je réagis juste sur Gabchampagne, je le cite : "Par contre, c'est bien puisque tu utilise fso."

Remarque infondée, fso est plus lent que les fonctions de fichier classiques incorporées à VB depuis QB, plus lourd à gérer, et plus lourd en cas de déploiement.

L'utilisation de FSO ne remonte pas le niveau du code, il l'enfonce.


@+
Celiphane
cs_Warny
Messages postés
478
Date d'inscription
mercredi 7 août 2002
Statut
Membre
Dernière intervention
10 juin 2015
-
=> renfield
oups, tu as raison
=> gabchampagne
toi aussi

ça donne donc :
for cursor = 1 to len(m)
mid$(m,cursor,1) = chr$((asc(mid$(m,cursor,1))+1) mod 256)
next cursor

ou pour les intimes du binaire (beaucoup plus puissant)
for cursor = 1 to len(m)
mid$(m,cursor,1) = chr$((asc(mid$(m,cursor,1))+1) and 255)
next cursor

ps: les deux fonctions ne sont pas equivalentes
x mod y <> x and (y-1) sauf si y est une puissance de 2
gabchampagne
Messages postés
216
Date d'inscription
mercredi 2 avril 2003
Statut
Membre
Dernière intervention
5 mai 2004
-
pi un ps : si il y a le caractère #255 à crypter, ça marchera pas car +1 = 256.
gabchampagne
Messages postés
216
Date d'inscription
mercredi 2 avril 2003
Statut
Membre
Dernière intervention
5 mai 2004
-
ben là. C POCHE. Ce type de cryptage est inutile si tu montre la démarche. Il faut pouvoir crypter à l'aide d'une clée. Par contre, c'est bien puisque tu utilise fso.
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
57 -
lol

de toute facon, la vitesse depends de la machine utilisée !

utilises ce code, ca sera encore plus rapide ;)

for cursor = 1 to len(m)
mid$(m,cursor,1) = chr$(asc(mid$(m,cursor,1))+1)
next cursor

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.