vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB4, VB5, VB602.01.02
Eigene Datei-Archive erstellen

Warum hunderte von Dateien einzeln speichern? Legen Sie die Dateien doch in einer Gesamtdatei ab!

Autor:  Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.669 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Ärgern Sie sich auch oft darüber, dass sich in einem Verzeichnis hunderte von kleinen Einzeldateien tummeln? Oder benötigt Ihre Anwendung viele zusätzliche Dateien, welche sie aber nicht alle einzeln installieren möchten?

Was liegt also näher, alle Dateien eines Ordners in eine einzige Gesamtdatei zu packen und diese Gesamtdatei (Archivdatei) bei Bedarf wieder zu extrahieren?

Eigentlich nichts - oder?

Dann kann's ja losgehen!
Zunächst müssen wir alle Dateien eines Ordners ermitteln. Dann Erstellen wir eine neue Archivdatei und speichern darin die Inhalte aller zuvor ermittelten Einzeldateien - hintereinander. Damit wir später wissen, wieviele Dateien das Archiv überhaupt enthält, merken wir uns die Anzahl in den ersten 4 Bytes der Datei. 4 Bytes deswegen, da wir die Anzahl als Longwert speichern. Das Entpacken der Einzeldateien soll natürlich wieder mit den Original-Dateinamen erfolgen. Also müssen wir uns in der Archivdatei ebenfalls die Originaldateinamen merken.

' Bestimmte/Alle Dateien eines Verzeichnisses
' in eine "ArchivDatei" packen
Public Function SaveFilesToArchiv( _
  ByVal sPath As String, _
  ByVal sArchiv As String, _
  Optional ByVal sPattern As String = "*.*) As Long
 
  Dim F As Integer 
  Dim N As Integer 
  Dim nLenFileName As Integer
  Dim nLenFileData As Long 
  Dim DirName As String 
  Dim FileData As String 
  Dim File() As String 
  Dim nFiles As Long
  Dim I As Long
  Dim lngUBound AS long
 
  ' ggf. abschliessenden Backslash anfügen 
  If Right$(sPath, 1) <> "\" Then sPath = sPath + "\" 
 
  ' Dateien im Verzeichnis ermitteln
  nFiles = 0
 
  DirName = Dir(sPath & sPattern, vbNormal)
  While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      nFiles = nFiles + 1
      If nfiles > lngUBound Then lngUBound = 2 * nFiles
      ReDim Preserve File(lngUBound)
      File(nFiles) = DirName 
    End If 
    DirName = Dir 
  Wend
  ReDim Preserve File(nFiles)
 
  ' Ggf. Archivdatei löschen
  If Dir(sArchiv) <> "" Then Kill sArchiv 
 
  ' Jetzt alle Dateien nacheinander in die
  ' Archivdatei speichern
  F = FreeFile 
  Open sArchiv For Binary As #F 
 
  ' Anzahl enthaltener Dateien
  Put #F, , nFiles 
 
  For I = 1 To nFiles 
    ' Dateiname speichern
    nLenFileName = Len(File(I)) 
    Put #F, , nLenFileName 
    Put #F, , File(I) 
 
    ' Datei-Inhalt einlesen
    N = FreeFile 
    Open sPath + File(I) For Binary As #N 
    FileData = Space$(LOF(N)) 
    Get #N, , FileData 
    Close #N 
 
    ' Datei-Inhalt in Archivdatei speichern
    nLenFileData = Len(FileData) 
    Put #F, , nLenFileData 
    Put #F, , FileData 
  Next I 
  Close #F 
 
  SaveFilesToArchiv = nFiles
End Sub

Entpacken der Dateien aus der Archivdatei
Nun brauchen wir noch das Gegenstück zu obiger Funktion - eine Funktion, die alle in einer Archivdatei enthaltenen Dateien in ein frei festlegbares Zielverzeichnis "entpackt":

' Alle Dateien aus dem Archiv extrahieren und in
' "sDestDir" speichern
Public Function ExtractFilesFromArchiv( _
  ByVal sArchiv As String, _
  ByVal sDestDir As String) As Long
 
  Dim F As Integer
  Dim N As Integer
  Dim nLenFileName As Integer
  Dim nLenFileData As Long
  Dim DirName As String
  Dim FileData As String
  Dim File As String
  Dim nFiles As Long
  Dim I As Long
 
  ' Prüfen, ob Archiv-Datei vorhanden
  If Dir(sArchiv) = "" Then
    MsgBox "Das Archiv existiert nicht!", 16
    Exit Function
  End If
 
  ' gf. abschliessenden Backslash anfügen
  If Right$(sDestDir, 1) <> "\" Then _
    sDestDir = sDestDir + "\"
 
  ' Archiv öffnen
  F = FreeFile
  Open sArchiv For Binary As #F
 
  ' Anzahl enthaltener Icons
  Get #F, , nFiles
 
  For I = 1 To nFiles
    ' Original-Dateinamen ermitteln
    Get #F, , nLenFileName
    File = Space$(nLenFileName)
    Get #F, , File
 
    ' Datei-Inhalt lesen
    Get #F, , nLenFileData
    FileData = Space$(nLenFileData)
    Get #F, , FileData
 
    ' Datei in "DestDir" speichern
    N = FreeFile
    Open sDestDir + File For Output As #N
    Print #N, FileData;
    Close #N
  Next I
  Close #F
 
  ExtractFilesFromArchiv = nFiles
End Function

Und so werden die beiden Funktionen aufgerufen:

' Dateien in Archiv packen
Dim nCount As Long
nCount = SaveFilesToArchiv("c:\temp\*.ico", _
  "f:\my-icons.dat"
MsgBox nCount & " Dateien in Archivdatei gespeichert."


' Dateien aus Archiv-Datei entpacken
Dim nCount As Long
ncount = ExtractFilesFromArchiv("f:\my-icons.dat", _
  "d:\temp")
MsgBox nCount & " Dateien extrahiert."