Ce code est un module, paru sur une Liste de discussions VB permettant de crypter tout type de fichiers (binaire ou ascii), il inclut aussi le decryptage de ces fichiers... Je rapelle que la legislation en France interdit des clefs supérieures à 128 Bits...
La fonction IsCrypted renvoie True ou False selon que le fichier à été crypté ou pas...
La fonction IsVersionCompatible permet de savoir si le fichier à été crypté avec cette version de cryptage, elle renvoye bien sur True ou False selon les cas...
Crypt_69 Prend pour paramètres le fichier source, puis le fichier cible et enfin le mot de pass (ou clef) de cryptage
Decrypt_69 prend les même paramètres (avec source et cible inversé bien sur)...
Notez que si la taille de la clef est identique au fichier à crypter, le décryptage par bruteforce est alors inutile...
Source / Exemple :
Option Explicit
' Mis en ligne par 69VobD3 (DivX-Paradise.net)
Public Function Crypt_69(Fichier As String, _
FichierCrypte As String, MotPasse As String)
' On definit les variables locales
Dim fs As Integer, fd As Integer
Dim OS As Byte, OD As Byte
Dim PtrMotPasse As Integer
Dim CheckSumMP As String * 10
Dim i As Double
Dim cle As Byte
' Init pointeur clé de cryptage à 1
PtrMotPasse = 1
' Ouverture des fichiers
' On efface le fichier destination si il existe déjà
If Dir(FichierCrypte, vbNormal) <> "" Then Kill FichierCrypte
'Ouverture du fichier de destination
fd = FreeFile
Open FichierCrypte For Binary Access Write As fd
'Ouverture du fichier source
fs = FreeFile
Open Fichier For Binary Access Read As fs
' Sablier
Screen.MousePointer = 11
' Ecriture du numéro de version
Put #fd, , "69"
' On ajoute le mot 'CRYPT69'
Put #fd, , "CRYPT69"
' Checksum de la clé de cryptage
CheckSumMP = String$(10, " ")
For i = 1 To Len(MotPasse)
CheckSumMP = Format(Val(CheckSumMP) + Asc(Mid$(MotPasse, i, 1)))
Next i
Put #fd, , CheckSumMP
' Boucle sur le fichier source
For i = 0 To LOF(fs) - 1
Get #fs, , OS
cle = 255 - Asc(Mid$(MotPasse, PtrMotPasse, 1))
If (CInt(OS) + CInt(cle)) > 255 Then
OD = CInt(OS) + CInt(cle) - 256
Else
OD = OS + cle
End If
Put #fd, , OD
PtrMotPasse = PtrMotPasse + 1
If PtrMotPasse > Len(MotPasse) Then
PtrMotPasse = 1
End If
Next i
'Fermeture des fichiers
Close fs
Close fd
'Remise de la souris normale
Screen.MousePointer = 0
End Function
Public Function DeCrypt_69(Fichier As String, _
FichierCible As String, MotPasse As String)
Dim fs As Integer, fd As Integer
Dim OS As Byte, OD As Byte
Dim PtrMotPasse As Integer
Dim CheckSumMP As Long
Dim i As Double
Dim cle As Byte
Dim Header As String * 19
' Init pointeur clé de cryptage à 1
PtrMotPasse = 1
' Ouverture fichier source
fs = FreeFile
Open Fichier For Binary Access Read As fs
Get #fs, , Header
' Vérif checksum clé de cryptage
For i = 1 To Len(MotPasse)
CheckSumMP = CheckSumMP + Asc(Mid$(MotPasse, i, 1))
Next i
If CheckSumMP <> Val(Mid$(Header, 10, 10)) Then
MsgBox "Decryptage Echoué !"
Close fs
Exit Function
End If
' Ouverture fichier destination
Kill FichierCible
fd = FreeFile
Open FichierCible For Binary Access Write As fd
' Sablier
Screen.MousePointer = 11
' Boucle sur le fichier source ( -entete)
For i = 0 To LOF(fs) - 1 - 19
Get #fs, , OS
cle = 255 - Asc(Mid$(MotPasse, PtrMotPasse, 1))
If (CInt(OS) - CInt(cle)) < 0 Then
OD = CInt(OS) - CInt(cle) + 256
Else
OD = OS - cle
End If
Put #fd, , OD
PtrMotPasse = PtrMotPasse + 1
If PtrMotPasse > Len(MotPasse) Then
PtrMotPasse = 1
End If
Next i
'Fermeture des fichiers
Close fs
Close fd
'Remise en placede la souris normale
Screen.MousePointer = 0
End Function
Private Function IsCrypted(Fichier As String) As Boolean
'Definit les variables
Dim f As Integer
Dim Header As String * 19
'Ouverture du fichier
f = FreeFile
Open Fichier For Binary Access Read As f
Get #f, , Header
Close f
If Mid(Header, 3, 7) = "CRYPT69" Then
IsCrypted = True
Else
IsCrypted = False
End If
End Function
Private Function IsVersionCompatible(Fichier As String) As Boolean
Dim f As Integer
Dim Header As String * 19
f = FreeFile
Open Fichier For Binary Access Read As f
Get #f, , Header
Close f
If Val(Mid(Header, 1, 2)) = 69 Then
IsVersionCompatible = True
Else
IsVersionCompatible = False
End If
End Function
Conclusion :
Attention, ce code ne m'appartient pas et je n'en suis pas l'auteur, je partage seulement cette ressource que je trouve formidable...
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.