Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2010 02 10 07:20:06

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

Fichier / Disque

> CRYPTAGE DÉCRYPTAGE DE FICHIER PAR MOT DE PASSE

CRYPTAGE DÉCRYPTAGE DE FICHIER PAR MOT DE PASSE

Information sur la source

Note :
Aucune note

Catégorie :Fichier / Disque

Classé sous :cryptage, décryptage, fichier, ARM, PIC Niveau :Initié Date de création :29/06/2009 Date de mise à jour :30/06/2009 15:14:11 Vu / téléchargé :3 269 / 326

Auteur : auban

Ecrire un message privé

Commentaire sur cette source (3)

Ajouter un commentaire et/ou une note

Description

Cette source crypt et decrypt simplement par un mot de passe et un codage interne à la source, le seul problème est que le fichier est 2 foix plus grand. Puisque je code sur 2 byte.

Le but dans cette appli est de pouvoir intégrer le décryptage dans un system embarqué basé sur un pic18f ou ARM7 par exemple avec une Carte SD, sans avoir besoin d'os sur les ARM.

Source

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

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

Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Crypt_Hex_file
- Crypt_Hex_file
  - bin
    - Debug
      - Crypt_Hex_file.xml 122 octets
  - My Project
    - Application.Designer.vb 440 octets
    - Application.myapp481 octets
    - AssemblyInfo.vb 1 292 octets
    - Resources.Designer.vb 2 802 octets
    - Resources.resx 5 612 octets
    - Settings.Designer.vb 3 048 octets
    - Settings.settings279 octets
  - obj
    - Debug
      - TempPE
      - Crypt_Hex_file.Resources.resources180 octets
      - Crypt_Hex_file.vbproj.GenerateResource.Cache784 octets
      - Crypt_Hex_file.xml 122 octets
    - Crypt_Hex_file.vbproj.FileListAbsolute.txt 2 259 octets
  - Crypt_Hex_file.vbproj 3 904 octets
  - Module1.vb 7 495 octets
- Crypt_Hex_file.sln 931 octets
- Crypt_Hex_file.suo18 432 octets

Télécharger le zip

Historique

30 juin 2009 15:14:12 :: But de l'appli

Sources de la même categorie

GESTION DE PARC AUTOMOBILE AVEC SÉRIALISATION par guyr07

FICHIERS_CACHÉS_LECTURE_SEULE par Le Pivert

CHANGEUR D'ICONES par djgab21

DIRECTDISKACCESS par XelectroX

UTILITAIRE WAV, MID ET MP3 par SnkVrt

Toutes les sources de la catégorie Fichier / Disque

Sources en rapport avec celle ci

CRYPTAGE ET DÉCRYPTAGE DE CHAÎNES ET DE FICHIERS [MODULE DE ... par PCPT

CRYPTAGE ET DÉCRYPTAGE DE TEXTE (SIMPLE) par miata

RC4 ENCRYPT/DECRYPT FONCTION par Joke758

CHARLIGMA par CHAR As Human

CRYPTAGE/DÉCRYPTAGE DES SCRIPTS "UNIVERSAL MATRICE V0.57" par Egyde

Commentaires et avis

Commentaire de Mayzz le 30/06/2009 14:51:21

Bonjour,

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

Commentaire de auban le 30/06/2009 15:12:27

Le but dans cette appli est de pouvoir intégrer le décryptage dans un system embarqué basé sur un pic18f ou ARM7 par exemple avec une Carte SD, sans avoir besoin d'os sur les ARM.

Commentaire de Mayzz le 30/06/2009 15:23:31

Oup's ! Autant pour moi, j'avais pas bien lu l'énoncé...

Il aurait fallut le mettre dans le titre ?

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Décryptage dans un dossier Temp [ par gotakk ] Bonjour, je suis débutant en visual basic et je fait un jeu sous frog creator. Mon problème est le suivant : j'ai trouvé une source qui à une fonctio décryptage fichier dbx [ par bizance ] Bonjour,Je n'y connais rien en VB, mais j'ai cherché sur votre site.Est-il possible de décrypter des fichiers dbx ?J'ai téléchargé un fichier ZIP de v CRYPTAGE [ par FREDM ] Je crypte actuellement des fichiers en applicant à chaque octet une clef XOR l'octet lu. Mon problème est qu'en C en prenant un bufer de 1024 le crypt Nouvelle méthode de cryptage [ par Sreizine ] Pour mon tritement de texte Texte XP ( http://www.vbfrance.com/article.aspx?Val=5725 )Je pensais à une nouvelle méthode de cryptage qui permettrai de Très urgent: Cryptage [ par YannGotti ] Je shouaiterais savoir s'il y à une possibilité de crypter un fichier avec une simple cléf stringFichier: |C:\Essais.txt|Code: |*****||Crypter| |Decry Cryptage introuvable sur le NET (VBS) [ par ABF ] Bonjour a tous. Je recherche une fonction permettant de crypter un fichier VBS ou du moins le code sans pour cela altéré celui-ci et donc q cryptage a la sortie et decryptage a l'entree ? [ par diablamanshadow ] bonsoir,voila j'aimerais savoir comment faire pour que quand je save du texte dans un fichier il crypte apres le fichier ou son contenu (j'avais pense Idée de cryptage [ par mJuJu ] Bonjour à tous et particulièrement les experts en cryptage. Voilà. Depuis quelque temps je m'intéresse un peu à la crypto, aux moyens de crypter un cryptage décryptage d'un mot de passe [ par faucheuse ] Bonjour tout le monde,Je me suis mis recemment aux macros sur excel, je connais donc quelques bases et me fournit en code sur internet(bien sur je ne cryptage application (vb6 utilisant liste et fichier texte [ par bayrem2 ] salut,je suis debutant en informatique , je une application vb que je la termine, je suis demandé de la crypte , mais je sais pas que çc veut dire cry

Nos sponsors

Derniers Blogs

UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante

TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice

[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion

TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice

TECHDAYS PARIS 2010 : DéPLOIEMENT DE NOUVELLES TECHNOLOGIES - RETOUR D'EXPéRIENCE PAR L'INFORMATIQUE DE MICROSOFT par ROMELARD Fabrice

Forum

RE : PROBLèME DE FILTRE EN ACCESS par wafik_has170

[EXCEL 2003] BOUTON QUI COPIE UNE LIGNE D'UNE FEUILLE à UNE AUTRE par freeman034

RE : GESTION DE LOCATION DE VOITURE par artbel2009

RE : COPIER COLLé APRES AVOIR FAIT UN FLITRE EN VBA par ucfoutu

RE : TIMER + SUCESSION DE MOT DANS UN LABEL OU TEXTBOX par liocifer

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

PLATEFORME SUR L ESOTERISME VOYANCE - sans charte graphique
Budget : 3 500€
Joomla 15 module paiement adaptation composant cuisine
Budget : 250€
Integrateur web dans template
Budget : 500€

Logiciels

DB-MAIN (9.1.0)
DB-MAIN (9.1.0)

DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal...

Cliquez pour télécharger DB-MAIN
Xilisoft DPG Convertisseur (5.1.37.0120)
XILISOFT DPG CONVERTISSEUR (5.1.37.0120)

Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé...

Cliquez pour télécharger Xilisoft DPG Convertisseur
GraphicsGale (2.01.01)
GRAPHICSGALE (2.01.01)

GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ...

Cliquez pour télécharger GraphicsGale
Architecte 3D (Platinum 2010)
ARCHITECTE 3D (PLATINUM 2010)

Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é...

Cliquez pour télécharger Architecte 3D
TeamViewer 5 (TeamViewer 5)
TEAMVIEWER 5 (TEAMVIEWER 5)

Dépanner un ami,expliquer une manipulation devient un jeu d'enfant. Prise en main d'un autre ord...

Cliquez pour télécharger TeamViewer 5