Soyez le premier à donner votre avis sur cette source.
Vue 7 869 fois - Téléchargée 700 fois
Imports System.IO Module Module1 Private Const MAX_CARAC = 80 Private Const TRAME = 3 Private nom_fichier_a_lire, nom_fichier_a_ecrire As String Private Pass_Lenght, Pass(MAX_CARAC), Pass_xor As Byte Private buffer_code(TRAME), buffer_caractere As Byte Private Choose As Char Private rnd1 As New Random() Private rand(4) As Byte Private lettre As Byte Private Code As Byte() = New Byte() {0, 94, 188, 226, 97, 63, 221, 131, 194 _ , 156, 126, 32, 163, 253, 31, 65, 157, 195, 33, 127 _ , 252, 162, 64, 30, 95, 1, 227, 189, 62, 96 _ , 130, 220, 35, 125, 159, 193, 66, 28, 254, 160 _ , 225, 191, 93, 3, 128, 222, 60, 98, 190, 224 _ , 2, 92, 223, 129, 99, 61, 124, 34, 192, 158 _ , 29, 67, 161, 255, 70, 24, 250, 164, 39, 121 _ , 155, 197, 132, 218, 56, 102, 229, 187, 89, 7 _ , 219, 133, 103, 57, 186, 228, 6, 88, 25, 71 _ , 165, 251, 120, 38, 196, 154, 101, 59, 217, 135 _ , 4, 90, 184, 230, 167, 249, 27, 69, 198, 152 _ , 122, 36, 248, 166, 68, 26, 153, 199, 37, 123 _ , 58, 100, 134, 216, 91, 5, 231, 185, 140, 210 _ , 48, 110, 237, 179, 81, 15, 78, 16, 242, 172 _ , 47, 113, 147, 205, 17, 79, 173, 243, 112, 46 _ , 204, 146, 211, 141, 111, 49, 178, 236, 14, 80 _ , 175, 241, 19, 77, 206, 144, 114, 44, 109, 51 _ , 209, 143, 12, 82, 176, 238, 50, 108, 142, 208 _ , 83, 13, 239, 177, 240, 174, 76, 18, 145, 207 _ , 45, 115, 202, 148, 118, 40, 171, 245, 23, 73 _ , 8, 86, 180, 234, 105, 55, 213, 139, 87, 9 _ , 235, 181, 54, 104, 138, 212, 149, 203, 41, 119 _ , 244, 170, 72, 22, 233, 183, 85, 11, 136, 214 _ , 52, 106, 43, 117, 151, 201, 74, 20, 246, 168 _ , 116, 42, 200, 150, 21, 75, 169, 247, 182, 232 _ , 10, 84, 215, 137, 107, 53} Sub Main() Do Until choose = "n" Initialisation() If ouverture_des_fichiers() = True Then Pass_xor = Password() Select Case Choose_Crypt() Case "c" cryptage(nom_fichier_a_lire, nom_fichier_a_ecrire, Pass_xor) Case "d" decryptage(nom_fichier_a_lire, nom_fichier_a_ecrire, Pass_xor) End Select End If Choose = recommencer() Loop End Sub #Region "Init et recommencer" Sub Initialisation() lettre = 0 nom_fichier_a_lire = "" nom_fichier_a_ecrire = "" End Sub Function recommencer() As Char Console.WriteLine("Voulez vous réeffectuer un cryptage ou un déccryptage (o/n) : ") Return Console.ReadLine End Function #End Region #Region "Fichier, Password, Choix Crypt ou Décrypt" Function ouverture_des_fichiers() As Boolean Console.WriteLine("Saisissez le nom du fichier d'entrée: ") nom_fichier_a_lire = Directory.GetCurrentDirectory & "\" & Console.ReadLine If Not File.Exists(nom_fichier_a_lire) Then Console.WriteLine("Problème d'ouverture du fichier d'entrée") Return False Exit Function End If Dim Extension As String Console.WriteLine("Saisissez l'extensione du fichier de Sortie : ") Extension = Console.ReadLine nom_fichier_a_ecrire = nom_fichier_a_lire nom_fichier_a_ecrire = nom_fichier_a_ecrire.Replace(Right(nom_fichier_a_lire, 3), Extension) If File.Exists(nom_fichier_a_ecrire) Then File.Delete(nom_fichier_a_ecrire) End If Dim fs As FileStream = File.Create(nom_fichier_a_ecrire) fs.Close() Return True End Function Function Password() As Byte Dim Pass_Entry As String Console.WriteLine("saisissez le mot de passe : ") Pass_Entry = Console.ReadLine Pass_Lenght = Pass_Entry.Length Dim pxor As Byte = 0 For curl As Byte = 0 To Pass_Lenght - 1 Pass(curl) = 255 - Asc(Pass_Entry.Chars(curl)) pxor = pxor Xor Pass(curl) Next Return pxor End Function Function Choose_Crypt() As String Console.WriteLine("Voulez vous effectuer un cryptage ou un décryptage (c/d) : ") Do Until Choose = "c" Or Choose = "d" Choose = Console.ReadLine Loop Return Choose End Function #End Region #Region "Cryptage et Décryptage" Sub Cryptage(ByVal Name_File As String, ByVal Name_File_write As String, ByVal Pass_Xor As Byte) lettre = 0 Dim buf_char As Byte FileOpen(1, Name_File, OpenMode.Binary, OpenAccess.Read) FileOpen(2, Name_File_write, OpenMode.Binary, OpenAccess.Write) Do FileGet(1, buf_char) Crypt_Byte(buf_char, Pass_Xor) FilePut(2, buffer_code(0)) FilePut(2, buffer_code(1)) If EOF(1) Then Exit Do Loop FileClose(1) FileClose(2) End Sub Sub Decryptage(ByVal Name_File As String, ByVal Name_File_write As String, ByVal Pass_Xor As Byte) lettre = 0 FileOpen(1, Name_File, OpenMode.Binary, OpenAccess.Read) FileOpen(2, Name_File_write, OpenMode.Binary, OpenAccess.Write) Do FileGet(1, buffer_code(0)) FileGet(1, buffer_code(1)) Decrypt_Byte(Pass_Xor) FilePut(2, buffer_caractere) If EOF(1) Then Exit Do Loop FileClose(1) FileClose(2) End Sub Sub Crypt_Byte(ByVal e As Byte, ByVal pass_xor As Byte) rnd1.NextBytes(rand) buffer_code(1) = rand(0) Xor Pass(lettre) Xor pass_xor lettre += 1 If lettre = Pass_Lenght Then lettre = 0 buffer_caractere = Code(e) buffer_code(0) = buffer_caractere Xor Pass(lettre) buffer_code(0) = buffer_code(0) Xor rand(0) buffer_code(1) = Code(buffer_code(1)) End Sub Sub Decrypt_Byte(ByVal pass_xor As Byte) Dim Rand_codage As Byte For i As Byte = 0 To 255 If Code(i) = buffer_code(1) Then buffer_code(1) = i : Exit For Next Rand_codage = buffer_code(1) Xor Pass(lettre) Xor pass_xor buffer_caractere = buffer_code(0) Xor Rand_codage lettre += 1 If lettre = Pass_Lenght Then lettre = 0 buffer_caractere = buffer_caractere Xor Pass(lettre) For i As Byte = 0 To 255 If Code(i) = buffer_caractere Then buffer_caractere = i : Exit For Next End Sub #End Region End Module
Il aurait fallut le mettre dans le titre ?
Il y a déja pleins d'exemples de programmes de ce type...
De plus en .Net le framework dispose de l'epace de nom System.Security.Cryptography qui contien plusieurs méthodes de cryptage selon les algos les plus répendus...
Ces méthodes sont rapides et efficaces, et elles sont native (du framework)...
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.