5/5 (10 avis)
Snippet vu 6 987 fois - Téléchargée 43 fois
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
26 janv. 2010 à 13:18
Merci d'avance pour votre aide
28 nov. 2007 à 12:47
19 déc. 2004 à 04:05
---
Pour ceux qui ont toujours pas compris ca kill que si le fichier destination existe déjà ^^
22 nov. 2004 à 15:37
est-ce que quelqu'un sait quel est la fonction qui la remplace
merci
24 août 2004 à 11:57
D'après niluje cette source fonctionne bien ( je le crois sur parole ) mais comment l'utiliser ???
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.