1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Cryptage de fichiers (tout types)

Cryptage de fichiers (tout types)

5/5 (10 avis)

Snippet vu 6 987 fois - Téléchargée 43 fois

Commenter

Contenu du snippet

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...

A voir également

Ajouter un commentaire Commentaires
gotakk
Messages postés
3
Date d'inscription
dimanche 9 décembre 2007
Statut
Membre
Dernière intervention
26 janvier 2010
26 janv. 2010 à 13:18
Je cherche ça depuis je ne sais combien de temps ! Mais il est possible de décrypter le fichier dans un autre dossier par exemple C:\WINDOWS\Temp

Merci d'avance pour votre aide
YannGotti
Messages postés
36
Date d'inscription
samedi 29 mars 2003
Statut
Membre
Dernière intervention
29 décembre 2010
 1
28 nov. 2007 à 12:47
Bonne source
cs_Yassan
Messages postés
12
Date d'inscription
samedi 25 janvier 2003
Statut
Membre
Dernière intervention
27 janvier 2007
19 déc. 2004 à 04:05
A noter qu'il faut supprimer la ligne kill fichiercible dans la fonction decrypt_69 car elle essaye de detruire un fichier qui n'a pas encors été créé
---
Pour ceux qui ont toujours pas compris ca kill que si le fichier destination existe déjà ^^
micky2be
Messages postés
2
Date d'inscription
mercredi 26 février 2003
Statut
Membre
Dernière intervention
2 mars 2005
22 nov. 2004 à 15:37
j'aimerais utilisé ce module sur un projet vb.net, mais la fonction sting$() n'est pas reconnu
est-ce que quelqu'un sait quel est la fonction qui la remplace

merci
VacheAlsacienne
Messages postés
1
Date d'inscription
lundi 23 août 2004
Statut
Membre
Dernière intervention
24 août 2004
24 août 2004 à 11:57
Hello...
D'après niluje cette source fonctionne bien ( je le crois sur parole ) mais comment l'utiliser ???
Afficher les 10 commentaires
S'inscrire maintenant

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.

Du même auteur (DivXPVobD)