CRYPTAGE DE FICHIERS (TOUT TYPES)

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