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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 013 fois - Téléchargée 31 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
18 juin 2004 à 23:38
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 473 Date d'inscription mercredi 7 août 2002 Statut Membre Dernière intervention 10 juin 2015
2 janv. 2004 à 19:01
=> 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
2 janv. 2004 à 00:44
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
2 janv. 2004 à 00:41
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 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 71
1 janv. 2004 à 23:28
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
Afficher les 6 commentaires

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.