CRÉATION D'UN FICHIER AUTOEXTRACTIBLE

Option Strict On
Module ModSave

    Friend PourCent As Integer = 0 'Avancement total
    Friend PourCentInFile As Integer = 0 'Avancement du fichier
    Friend CurrentPath As String = "" 'Fichier courant
    Friend NewThread As Threading.Thread 'Déclaration du Thread
    Friend BytesWrite As Long = 0 'Octets écrits

    Friend Source, Destination, Nom As String 'Source, Destination et Nom

    Friend Sub StartSave()
        'Démarrage du Thread
        NewThread = New Threading.Thread(AddressOf StartThread)
        NewThread.Start()
    End Sub

    Private Sub StartThread()
        'Procédure du démarrage du Thread
        SaveDir()
        End
    End Sub

    Public Sub SaveDir()

        Try

            'On initie les valeurs

            PourCent = 0
            PourCentInFile = 0

            Dim CurrentFile As IO.FileStream 'Fichier courant qui va être lu
            Dim CurrentFileInfo As IO.FileInfo 'Infos sur le fichier qui va être lu

            Dim BytesStep As Integer = 1024 * 512  'Nombre d'octets à lire à la fois
            Dim Bytes(BytesStep) As Byte 'Le tableau de bytes
            Dim BytesRead As Integer 'Octets lus dans le flux

            Dim PathFile As String = "" 'Chemin du fichier
            Dim DirOfPathFile As String = "" 'Chemin du répertoire du fichier

            'On créé une liste de tous les fichiers

            Dim TblFiles() As String

            TblFiles = IO.Directory.GetFiles(Source, "*.*", IO.SearchOption.AllDirectories)

            'On créé le répertoire de la sauvegarde s'il n'existe pas

            If IO.Directory.Exists(Destination & "\" & Nom) = False Then IO.Directory.CreateDirectory(Destination & "\" & Nom)

            'On copie le projet Exe de restauration si le fichier cible n'exite pas

            IO.File.Copy(Application.StartupPath & "\RestoreData.dat", Destination & "\" & Nom & "\" & Nom & ".exe", True)

            'On ouvre un nouveau flux dans le fichier cible après l'Exe servant au déchiffrage

            Dim FileCible As New IO.FileStream(Destination & "\" & Nom & "\" & Nom & ".exe", IO.FileMode.Append, IO.FileAccess.Write, IO.FileShare.ReadWrite, BytesStep)

            'On met la position du flux à la fin des données du programme de restauration du fichier cible

            Dim InfoFileRestore As New IO.FileInfo(Application.StartupPath & "\RestoreData.dat")

            'Creation du début des données du fichier Xml contenant toutes les données nécéssaires au déchiffrage

            Dim DataFileXml As String = ""

            DataFileXml = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>"
            DataFileXml &= "<Structure>"

            'On sauve tous les fichiers

            For u As Integer = 0 To (TblFiles.Length - 1)

                Try

                    CurrentPath = TblFiles(u) 'On change de fichier courant
                    CurrentFile = New IO.FileStream(TblFiles(u), IO.FileMode.OpenOrCreate, IO.FileAccess.Read, IO.FileShare.Read, BytesStep) 'On change de fichier de lecture, on donne les acces et on met le buffer sur 16 octets
                    CurrentFileInfo = New IO.FileInfo(TblFiles(u)) 'Info sur le fichier en lecture courant

                    PathFile = Replace(TblFiles(u), Source, "") 'On ne garde que le chemin qui se trouve dans le répertoire soure
                    If Microsoft.VisualBasic.Left(PathFile, 1) = "\" Then PathFile = Mid(PathFile, 2) 'On enlève le "\" du début
                    DirOfPathFile = Replace(CurrentFileInfo.DirectoryName, Source, "") 'On ne garde que le chemin qui se trouve dans le répertoire soure
                    If Microsoft.VisualBasic.Left(DirOfPathFile, 1) = "\" Then DirOfPathFile = Mid(DirOfPathFile, 2) 'On enlève le "\" du début

                    DataFileXml &= "<Fichier>" & "<Chemin>" & PathFile & "</Chemin>" & "<Debut>" & CStr(FileCible.Position) & "</Debut>" & "<Taille>" & CStr(CurrentFile.Length) & "</Taille>" & "<DirPath>" & DirOfPathFile & "</DirPath>" & "</Fichier>" 'Eriture des infos du fichier nécéssaires au déchiffrage dans le fichier Xml

                    For i As Long = 1 To (CurrentFile.Length) Step BytesStep 'On lit BytesStep à la fois
                        BytesRead = CurrentFile.Read(Bytes, 0, (BytesStep - 1)) 'On lit n octets et on range tout ca dans Bytes
                        FileCible.Write(Bytes, 0, BytesRead) 'On les ecrit dans le fichier de destination si le tabelau d'octets est different
                        BytesWrite = FileCible.Position 'Bytes écrits
                        If (CurrentFile.Length - 1) > 0 Then PourCentInFile = CInt(Math.Round(i / (CurrentFile.Length - 1) * 100)) 'Progression de l'écriture 
                    Next i

                    CurrentFile.Close() 'On ferme le fichier de lecture pour passer au suivant
                    CurrentFile = Nothing 'CurrentFile vaut plus rien

                    If (TblFiles.Length - 1) > 0 Then PourCent = CInt(Math.Round(u / (TblFiles.Length - 1) * 100)) 'Avancement par Fichier

                Catch ex As Exception
                    MsgBox("Erreur : " & vbCrLf & ex.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Critical, "Erreur") 'Erreur!
                End Try

            Next u

            'On ferme le fichier cible

            FileCible.Close()
            FileCible = Nothing

            DataFileXml &= "</Structure>" 'On termine le fichier Xml

            'On sauve les données Xml

            Dim FileXml As New IO.StreamWriter(New IO.FileStream(Destination & "\" & Nom & "\" & Nom & ".xml", IO.FileMode.Create, IO.FileAccess.Write), System.Text.Encoding.UTF8)

            FileXml.Write(DataFileXml)

            'On ferme le fichier Xml

            FileXml.Close()


        Catch ex As Exception
            MsgBox("Erreur : " & vbCrLf & ex.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Critical, "Erreur")
        End Try

    End Sub

End Module

-------------------------------------------------------------------------------------------------------------------------------------

Option Strict On
Module ModRestore
    Friend PourCent As Integer = 0 'Avancement total
    Friend PourCentInFile As Integer = 0 'Avancement du fichier
    Friend CurrentPath As String = "" 'Fichier courant en cours d'extraction
    Friend NewThread As Threading.Thread 'Déclaration du thread

    Friend BytesWrite As Long = 0 'Octets écrits

    Friend Source As String 'Source (L'executable)
    Friend PathCible As String 'Repertoire d'extraction

    Friend Sub StartRestore()
        'Démarrage du Thread
        NewThread = New Threading.Thread(AddressOf StartThread)
        NewThread.Start()
    End Sub

    Private Sub StartThread()
        'Procédure du démarrage du Thread
        Source = Application.ExecutablePath 'La source est evidemment l'Exe lui même d'où le terme "autoextractible"
        RestoreDir()
        End
    End Sub

    Private Sub RestoreDir()

        Try

            'On definit les variables

            Dim FilePath, DirPath As String 'Chemin du fichier de destination
            Dim FileLenght, FilePosition As Long 'Position dans le fichier .dat et longueur

            Dim CurrentFile As IO.FileStream 'Flux du fichier de sortie

            Dim BytesStep As Integer = 1024 * 512 'Nombre d'octets à lire à la fois
            Dim Bytes(BytesStep) As Byte 'Le tableau de bytes
            Dim BytesRead As Integer 'Octets lus dans le flux
            Dim MaxLenght As Integer 'Longueur maximum d'oectets à lire


            'On initie les valeurs

            PourCent = 0
            PourCentInFile = 0
            If Microsoft.VisualBasic.Right(PathCible, 1) <> "\" Then PathCible &= "\" 'On rajoute "\" s'il n'existe pas

            'On definit le fichier de sauvegarde xml

            Dim DataFilePath As String = Mid(Source, 1, Source.Length - 3) & "xml"

            'On ouvre le fichier xml qui contient les informations nécéssaires à la restauration

            Dim XInfoFiles As New Xml.XmlDocument
            XInfoFiles.Load(DataFilePath)

            'On ouvre le fichier data avec les acces et un buffer de 16

            Dim DataFile As New IO.FileStream(Source, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read, BytesStep)

            'Parcours du fichier XMl et restauration des données

            For u As Integer = 0 To (XInfoFiles.DocumentElement.ChildNodes.Count - 1)

                Try

                    'Lecture des infos

                    FilePath = PathCible & XInfoFiles.DocumentElement.ChildNodes(u).ChildNodes(0).ChildNodes(0).Value
                    FilePosition = CLng(XInfoFiles.DocumentElement.ChildNodes(u).ChildNodes(1).ChildNodes(0).Value)
                    FileLenght = CLng(XInfoFiles.DocumentElement.ChildNodes(u).ChildNodes(2).ChildNodes(0).Value)
                    If XInfoFiles.DocumentElement.ChildNodes(u).ChildNodes(3).ChildNodes.Count > 0 Then DirPath = PathCible & (XInfoFiles.DocumentElement.ChildNodes(u).ChildNodes(3).ChildNodes(0).Value) Else DirPath = PathCible

                    If IO.Directory.Exists(DirPath) = False Then IO.Directory.CreateDirectory(DirPath) 'Si le dossier existe pas, on le créé

                    CurrentPath = FilePath 'Mise dans la variable du fichier courant en cours d'extraction
                    CurrentFile = New IO.FileStream(FilePath, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.Write, BytesStep) 'On ouvre le fichier où écrire les données avec les accès et toujours un buffer de 16 octets

                    DataFile.Position = FilePosition 'On va a la position du début du fichier

                    MaxLenght = BytesStep

                    For i As Long = 1 To (FileLenght) Step BytesStep 'n octet par n octet, on créé le fichier
                        If CurrentFile.Position + MaxLenght > FileLenght Then MaxLenght = CInt(FileLenght - CurrentFile.Position + 1)
                        BytesRead = DataFile.Read(Bytes, 0, (MaxLenght - 1)) 'On lit n octets dans le fichier autoextractible
                        CurrentFile.Write(Bytes, 0, BytesRead) 'Et on les écrits
                        BytesWrite = DataFile.Position 'Bytes écrits
                        If (FileLenght - 1) > 0 Then PourCentInFile = CInt(Math.Round(i / FileLenght * 100)) 'Progression de l'écriture
                    Next i

                    'On ferme le fichier écrit pour passer au suivant

                    CurrentFile.Close()
                    CurrentFile = Nothing

                    If (XInfoFiles.DocumentElement.ChildNodes.Count - 1) > 0 Then PourCent = CInt(Math.Round(u / (XInfoFiles.DocumentElement.ChildNodes.Count - 1) * 100)) 'Avancement par Fichier

                Catch ex As Exception
                    MsgBox("Erreur : " & vbCrLf & ex.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Critical, "Erreur") 'Erreur!
                End Try

            Next u

            'On ferme le fichier data

            DataFile.Close()
            DataFile = Nothing

        Catch ex As Exception
            MsgBox("Erreur : " & vbCrLf & ex.Message, MsgBoxStyle.OkOnly Or MsgBoxStyle.Critical, "Erreur")
        End Try

    End Sub

End Module

Télécharger le zip

29 octobre 2006 18:03:30 :

Petite erreur qui n'empêchait pas le fonctionnement du script.

30 octobre 2006 08:52:15 :

Au lieu de lire 16 octets à la fois, on en lit un.

04 novembre 2006 16:08:58 :

Vitesse d'écriture, Choix du répertoire d'extraction, Vitesse passe de 10Ko/sec à 30Mo/Sec (chez moi..), Fichiers intacts à l'extraction