Spliteur de fichier

Soyez le premier à donner votre avis sur cette source.

Vue 6 734 fois - Téléchargée 423 fois

Description

Un petit programme simple qui permet de découper un fichier en morceaux (de taille choisie) puis de recoller les morceau pour retrouver le fichier original...

Source / Exemple :



      • CLASSE SCRITCH/UNSCRITCH ***
Option Explicit Const ENTETE = "Scritcher_______________________________________________________________________" 'entete 'position 15 : 3 octets (en string) : longueur du nom de fichier 'position 18 : nom du fichier 'position len(ENTETE)+1 : 3 octets (en string) : n° du scritch 'position len(ENTETE)+4 : 3 octets (en string) : total des scritchs ' Dim TailleEntete As Integer Private SizeFile As Long Public Event ProgressScritch(OctetsScritched As Long, OctectsRemaning As Long, FilesScritched As Integer, FilesRemaning As Integer) Public Event ProgressUnScritch(OctetsUnScritched As Long, OctectsRemaning As Long, FilesUnScritched As Integer, FilesRemaning As Integer) Public Function GoUnScritch(ByVal FinalFile As String, FilesToUnScritch() As String, ErrMsg As String) As Boolean Dim NumFich() As Integer Dim FilePosi As Long Dim Tampon1 As String * 1 Dim Tampon10 As String * 10 Dim Tampon100 As String * 100 Dim Tampon1000 As String * 1000 Dim Tampon10000 As String * 10000 Dim i As Integer Dim WritePosi As Long Dim ReadPosi As Long Dim tmpEntete As String Dim oRestant As Double On Error GoTo err_GoUnscritch Screen.MousePointer = vbHourglass GoUnScritch = False ReDim NumFich(0 To UBound(FilesToUnScritch)) NumFich(0) = FreeFile TailleEntete = Len(ENTETE) + 6 Open FinalFile For Binary As NumFich(0) WritePosi = 1 For i = 1 To UBound(FilesToUnScritch) NumFich(i) = FreeFile Open FilesToUnScritch(i) For Binary As NumFich(i) ReadPosi = TailleEntete + 1 Do Until ReadPosi > TailleFichier(FilesToUnScritch(i)) oRestant = TailleFichier(FilesToUnScritch(i)) - ReadPosi If oRestant > 2 Then oRestant = oRestant - 1 'oRestant = 1 Select Case oRestant Case 0 To 9 Get NumFich(i), ReadPosi, Tampon1 Put NumFich(0), WritePosi, Tampon1 WritePosi = WritePosi + 1 ReadPosi = ReadPosi + 1 Case 10 To 99 Get NumFich(i), ReadPosi, Tampon10 Put NumFich(0), WritePosi, Tampon10 WritePosi = WritePosi + 10 ReadPosi = ReadPosi + 10 Case 100 To 999 Get NumFich(i), ReadPosi, Tampon100 Put NumFich(0), WritePosi, Tampon100 WritePosi = WritePosi + 100 ReadPosi = ReadPosi + 100 Case 1000 To 9999 Get NumFich(i), ReadPosi, Tampon1000 Put NumFich(0), WritePosi, Tampon1000 WritePosi = WritePosi + 1000 ReadPosi = ReadPosi + 1000 Case Else Get NumFich(i), ReadPosi, Tampon10000 Put NumFich(0), WritePosi, Tampon10000 WritePosi = WritePosi + 10000 ReadPosi = ReadPosi + 10000 End Select RaiseEvent ProgressUnScritch(WritePosi, 0, i, UBound(FilesToUnScritch)) Loop Next i For i = 0 To UBound(FilesToUnScritch) Close NumFich(i) Next i GoUnScritch = True ErrMsg = "Ok" Screen.MousePointer = vbDefault Exit Function err_GoUnscritch: GoUnScritch = False ErrMsg = "Une erreur est survenue durant l'opération" Screen.MousePointer = vbDefault End Function Public Function GoScritch(FileToScritch As String, FileWhereScritch As String, PathWhereScritch As String, SizeScritch As Long, OutputFiles() As String, ErrMsg As String) As Boolean Dim NumFich() As Integer Dim tmpEntete As String Dim FilePosi As Long Dim WritePosi As Long Dim FileToWrite As Integer Dim Tampon1 As String * 1 Dim Tampon10 As String * 10 Dim Tampon100 As String * 100 Dim Tampon1000 As String * 1000 Dim Tampon10000 As String * 10000 Dim FileNameToScritch As String Dim FileNameEntete As String Dim i As Integer Dim oRestant As Long On Error GoTo err_GoScritch Screen.MousePointer = vbHourglass SizeFile = TailleFichier(FileToScritch) TailleEntete = Len(ENTETE) + 6 GoScritch = False If SizeScritch < (SizeFile / 1024) Then 'initialisation des fichiers 'ReDim NumFich(0 To (SizeFile / (SizeScritch * 1024 - TailleEntete) + 1)) ReDim NumFich(0 To Fix(SizeFile / (SizeScritch * 1024)) + 1) ReDim OutputFiles(1 To Fix(SizeFile / (SizeScritch * 1024)) + 1) NumFich(0) = FreeFile Open FileToScritch For Binary As NumFich(0) For i = 1 To UBound(NumFich) NumFich(i) = FreeFile 'Open PathWhereScritch & "s_" & FileWhereScritch & "." & CStr(Format(i, "000")) For Binary As NumFich(i) Open PathWhereScritch & FileWhereScritch & "_" & CStr(Format(i, "000")) & ".tch" For Binary As NumFich(i) 'écriture des entêtes tmpEntete = ENTETE & Format(i, "000") & Format(UBound(NumFich), "000") Put NumFich(i), 1, tmpEntete FileNameToScritch = Dir(FileToScritch) FileNameEntete = CStr(Format(Len(FileNameToScritch), "000")) & FileNameToScritch Put NumFich(i), 15, FileNameEntete Next i 'découpage du fichier FilePosi = 1 FileToWrite = FilePosi \ (SizeScritch * 1024 - TailleEntete) + 1 Do Until FilePosi > SizeFile 'octets restant à écrire dans le fichier courant oRestant = (SizeScritch * 1024 - TailleEntete) - ((FilePosi - 1) - ((FileToWrite - 1) * (SizeScritch * 1024 - TailleEntete))) If oRestant > 2 Then oRestant = oRestant - 1 'oRestant = 1 Select Case oRestant Case 1 To 9 Get NumFich(0), FilePosi, Tampon1 WritePosi = FilePosi + TailleEntete - ((FileToWrite - 1) * (SizeScritch * 1024 - TailleEntete)) Put NumFich(FileToWrite), WritePosi, Tampon1 FileToWrite = FilePosi \ (SizeScritch * 1024 - TailleEntete) + 1 FilePosi = FilePosi + 1 Case 10 To 99 Get NumFich(0), FilePosi, Tampon10 WritePosi = FilePosi + TailleEntete - ((FileToWrite - 1) * (SizeScritch * 1024 - TailleEntete)) Put NumFich(FileToWrite), WritePosi, Tampon10 FileToWrite = FilePosi \ (SizeScritch * 1024 - TailleEntete) + 1 FilePosi = FilePosi + 10 Case 100 To 999 Get NumFich(0), FilePosi, Tampon100 WritePosi = FilePosi + TailleEntete - ((FileToWrite - 1) * (SizeScritch * 1024 - TailleEntete)) Put NumFich(FileToWrite), WritePosi, Tampon100 FileToWrite = FilePosi \ (SizeScritch * 1024 - TailleEntete) + 1 FilePosi = FilePosi + 100 Case 1000 To 9999 Get NumFich(0), FilePosi, Tampon1000 WritePosi = FilePosi + TailleEntete - ((FileToWrite - 1) * (SizeScritch * 1024 - TailleEntete)) Put NumFich(FileToWrite), WritePosi, Tampon1000 FileToWrite = FilePosi \ (SizeScritch * 1024 - TailleEntete) + 1 FilePosi = FilePosi + 1000 Case Else Get NumFich(0), FilePosi, Tampon10000 WritePosi = FilePosi + TailleEntete - ((FileToWrite - 1) * (SizeScritch * 1024 - TailleEntete)) Put NumFich(FileToWrite), WritePosi, Tampon10000 FileToWrite = FilePosi \ (SizeScritch * 1024 - TailleEntete) + 1 FilePosi = FilePosi + 10000 End Select RaiseEvent ProgressScritch(FilePosi, SizeFile, FileToWrite, UBound(NumFich)) Loop 'fermeture des fichiers For i = 0 To UBound(NumFich) Close NumFich(i) Next i GoScritch = True Else 'fichier trop petit ErrMsg = "La taille du fichier source est inférieure la taille du 'Scritch' demandée..." GoScritch = False End If Screen.MousePointer = vbDefault Exit Function err_GoScritch: GoScritch = False ErrMsg = "Une erreur est survenue!!!" Screen.MousePointer = vbDefault End Function Public Function InfoFileScritch(PathFile As String, FileName As String, ScritchNumber As Integer, ScritchTotal As Integer) As Boolean Dim NumFich As Integer Dim Tampon As String * 50 Dim Tampon2 As String * 3 Dim Temp As Integer On Error GoTo err_InfoFileScritch NumFich = FreeFile Open PathFile For Binary As NumFich 'nom de fichier Get NumFich, 15, Tampon Temp = Val(Mid(Tampon, 1, 3)) FileName = Mid(Tampon, 4, Temp) 'numero de scritch Get NumFich, Len(ENTETE) + 1, Tampon2 ScritchNumber = Val(Tampon2) 'total scritch Get NumFich, Len(ENTETE) + 4, Tampon2 ScritchTotal = Val(Tampon2) Close NumFich If FileName = "" Or ScritchNumber = 0 Or ScritchTotal = 0 Or ScritchNumber > ScritchTotal Then InfoFileScritch = False Else InfoFileScritch = True End If Exit Function err_InfoFileScritch: InfoFileScritch = False End Function '************************ Private Function TailleFichier(NomFichier As String) As Long Dim Fs As Object Dim f As Object On Error GoTo err_TailleFichier Set Fs = CreateObject("Scripting.FileSystemObject") Set f = Fs.getfile(NomFichier) TailleFichier = f.Size Exit Function err_TailleFichier: TailleFichier = 0 End Function Private Function Char2Hexa(Valeur As String) As String Dim t As Integer t = Asc(Valeur) Char2Hexa = Hex(t) End Function Private Function Hexa2String(Valeur As String) As String Hexa2String = Chr(Val("&H" & Valeur)) End Function

Conclusion :


Deux onglets, un pour le découpage (Scritchage) et un pour le recollage (Unscritchage)...
Dans le deuxième onglet, le choix de n'importe quel fichier découpé permet au programme de retrouver tous les autres (s'il sont dans le même répertoire, bien sûr)
Un bouton permet d'effacer d'un coup tous les fichiers découpés après la restoration du fichier original

NOTE : Il y a une restriction sur la longueur de nom de fichier source (au delà de cinquante caractère, cela ne fonctionne plus)

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_Ordiman
Messages postés
40
Date d'inscription
mercredi 5 juin 2002
Statut
Membre
Dernière intervention
28 avril 2004
-
C'est génial mais il faut éviter de lui dire de copier directement les "Scritchs" sur disquette car il ne préviens pas qu'il faut changer de disquette, et puis deux ou trois optimisations par-ci par-là ...

Mais il marche très bien, je le conseille vivement à tout le monde
Bravo ! 9/10
cs_iubito
Messages postés
629
Date d'inscription
mercredi 3 juillet 2002
Statut
Membre
Dernière intervention
9 octobre 2006
-
OOOOHHHH YES!!!!!!
Enfin 1 prog ki marche bien ;) J'ai découpé mon 280 Mo comme ça, facile!!!
Ouais, les autres marchent aussi mais ils bouffent 60+ Mo de RAM comme c pas permi (d softs payant ou d'autres sources de ce site !!!) alors ke çui-là il reste à 7 ou 8 Mo de RAM oqp.
Suuupppppeeeeeeeerrrrrrrrrrrr!
cs_rst
Messages postés
2
Date d'inscription
dimanche 1 avril 2001
Statut
Membre
Dernière intervention
7 avril 2002
-
jeromekj > la réponse est oui... cela prend un peu de temps, mais cela fonctionne... Je te soupçonne de penser à découper des DivX pour les mettre sur des CD ;-)
jeromekj
Messages postés
9
Date d'inscription
mardi 8 janvier 2002
Statut
Membre
Dernière intervention
10 avril 2006
-
peut on couper de très gros fichiers ? g moi même essayé ds le passé de réaliser un splitter, mais je me suis heurté à la difficulté suivante, je souhaité des fichiers de 600 MO environ. l'original faisant 1200 MO
Tres tres bien ce prog

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.