Petit concaténeur/déconcaténeur pour gerer des dossier. Vous pouvez par exemple utiliseer ceci et ensuite le compresser avec l'algorithme d'huffman pour gerer pusieur dossier dans une application et les compresser une fois le travail fini pour limiter l'espace utiliser par un dossier.
Il suffit d'appeler une procédure d'indiquer le dossier, les fichier (ex: "*.TXT") et le fichier de destination pour concatener et compresser ensuite. le contraire pour reouvrir le dossier
Source / Exemple :
Sub Concatène(ByVal Path As String, ByVal Filename As String, ByVal DestFile As String)
Dim Longueur As Long
Dim txt() As Byte
Dim File As String
Dim i As Long
File = dir(Path & "\" & Filename)
i = 0
While File <> "" 'Compte le nombre de fichier
i = i + 1
File = dir
Wend
File = dir(Path & "\" & Filename)
Open DestFile For Output As #1 'Détruit le fichier si il existe
Close
Open DestFile For Binary As #1 'Ouvre le fichier en mode binaire
Put #1, , i 'Inscrit le nombre de fichier contenu dans le fichier
While File <> "" 'Boucle sur tout les fichier
Longueur = Len(File)
Put #1, , Longueur 'inscrit longueur du nom de fichier
Put #1, , File 'txt 'inscrit le nom de fichier
Open Path & "\" & File For Binary As #2 'Ouvre le fichier à Concaténer
ReDim txt(1 To LOF(2)) 'Dimensionne le tableau de Byte
Get #2, 1, txt() 'Lit tout le fichier
'txt = Input(LOF(2), 2) 'même chose mais avec txt de type string
Longueur = UBound(txt)
Put #1, , Longueur 'Inscrit le nombre de caractère
Put #1, , txt() 'Inscrit les caractère du fichier
Close #2 'Ferme le fichier 2
File = dir 'Passe au fichier suivant
Wend ''Recommence la boucle
Close #1 'Ferme le fichier 1
End Sub
Sub Déconcatène(ByVal Filename As String)
Dim Longueur As Long
Dim txt() As Byte
Dim File As String
Dim i As Long
DestFile = Filename
fr1 = FreeFile
Open DestFile For Binary As #fr1
fr2 = FreeFile
Get #fr1, , i
For Index = 1 To i
Get #fr1, , Longueur
File = ExtractFileName(Input(Longueur, #fr1))
Open Path & "\" & File For Output As #fr2
Close #fr2
Open Path & "\" & File For Binary As #fr2
Get #fr1, , Longueur
ReDim txt(1 To Longueur)
Get #fr1, , txt()
Put #fr2, , txt()
Close #fr2
Next Index
Close
End Sub
Conclusion :
J'ai commenter le source...Histoire qu'il soit un peu plus dans l'optique du site :-)
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.