Cryptage de fichiers (tout types)

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

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)