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

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

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.