vb@rchiv · Workshops · Eigenes Dateisystem innerhalb einer Datei

Rubrik: Dialoge/Dateien | VB-Versionen: VB5, VB6

01.08.03

Eigenes Dateisystem innerhalb einer Datei Ein eigenes Dateisystem innerhalb einer Datei: dieses Thema wurde vor einiger Zeit in den vb@rchiv-Foren diskutiert. Inspiriert von der Idee, Daten endlich etwas komplexer speichern zu können, enstand so eine selbst erstellte Klasse, mit der sich ein eigenes Dateisystem innerhalb einer einzigen Datei erstellen und verwalten lässt.
Autor: E7	Bewertung:	Views: 24.446

Ein eigenes Dateisystem innerhalb einer Datei: dieses Thema wurde vor einiger Zeit in den vb@rchiv-Foren diskutiert. Inspiriert von der Idee, Daten endlich etwas komplexer speichern zu können, enstand so eine selbst erstellte Klasse, mit der sich ein eigenes Dateisystem innerhalb einer einzigen Datei erstellen und verwalten lässt.

Am Anfang musste ich mir erst einmal die Grundlagen überlegen. Das Dateisystem soll universell und wiederverwendbar sein - ein Klassenmodul also. Erstellen Sie ein neues Projekt, fügen diesem ein leeres Klassenmodul hinzu und ändern den Namen Class1 nach clsFileSystem.

Was darf bei einem guten VB-Code nicht fehlen? Richtig!

Option Explicit

Damit zwingt mich VB, Variablen vor deren Verwendung zu deklarieren. Ohne diese Anweisung sind Tippfehler im Code nur schwer ersichtlich, was zu stundenlanger Fehlersuche ausarten kann.

Als nächstes benötigen wir eine Variable, in der der Dateiname der aktuell geöffneten Datei gespeichert wird:

' Dateiname des neuen DateiSystems
Private m_FileSystemName As String

Wir wollen ja mit einer Klasse auch bequem umgehen können. So öffnet der Programmierer (fast hätte ich NUTZER geschrieben) einmal das Dateisystem und muss den Dateinamen später nicht mehr angeben.

Um die Daten auszulesen und zu schreiben, brauchen wir noch zwei kleine Hilfsfunktionen:

' Inhalt einer Datei auslesen und als String zurückgeben
Private Function GetFile(ByVal sFilename As String, _
  Optional ByVal nStart As Long = 1, _
  Optional ByVal nLen As Long)
     Dim sBuffer As String
  Dim F As Long
 
  On Error Resume Next
  If nLen > 0 Then
    sBuffer = Space$(nLen)
  Else
    sBuffer = Space$(FileLen(sFilename))
  End If
 
  If Err.Number = 0 Then
    F = FreeFile
    Open sFilename For Binary As #F
    Get #F, nStart, sBuffer
    Close #F
  End If
  On Error GoTo 0
 
  GetFile = sBuffer
End Function

' Buffer (String) in eine Datei speichern
Private Sub SaveFile(ByVal sFilename As String, _
  ByVal sBuffer As String, _
  Optional ByVal nStart As Long = 1)
 
  Dim F As Long
 
  On Error Resume Next
  If nStart = 1 Then Kill sFilename
 
  F = FreeFile
  Open sFilename For Binary As #F
  Put #F, nStart, sBuffer
  Close #F
End Sub

Bei obigen Funktionen muss der Dateiname angegeben werden; aber das macht die Klasse und stört später niemanden mehr.

Als nächstes benötigen wir zwei Funktionen - eine, um neue Dateisysteme anzulegen, und eine, um vorhandene zu öffnen:

' Damit erzeugen Sie ein neues Dateisystem.
' DiskFileName: Dateiname wie z. B. c:\temp.efs
Public Sub CreateFS(ByVal sDiskFileName As String)
  Dim sInit As String
 
  sInit = "E7FS002" & Space(15 * 3) & _
    Space(40960)  ' 512*80
 
  SaveFile sDiskFileName, sInit
  m_FileSystemName = sDiskFileName
End Sub

' Damit öffnen Sie ein vorhandenes Dateisystem
' DiskFileName: Dateiname wie z. B. c:\temp.efs
Public Function OpenFS(ByVal sDiskFileName As String) As Boolean
  If GetFile(sDiskFileName, 1, 4) <> "E7FS" Then
    OpenFS = False
  Else
    m_FileSystemName = sDiskFileName
    OpenFS = True
  End If
End Function

Richten Sie Ihre Augen auf folgende Zeile:

sInit = "E7FS002" & Space(15 * 3) & Space(40960)

Hier sehen Sie den sogenannten Header der Datei. Am Anfang steht hier "E7FS002", was so viel bedeutet wie "E7 FileSystem Version 002" (ich hatte auch schon Version 1 geschrieben, war aber fast komplett fehlerhaft). Anschließend werden 15 * 3 Leerzeichen geschrieben. Hier werden zusätzliche Daten abgelegt, jeweils 15 Bytes für Datenträgername, Datenträgerbeschreibung und ein Kommentar. Danach kommen 40960 Leerzeichen, die Platz für die Dateitabelle bieten. Eine Datei belegt in der Dateitabelle 80 Bytes; für 512 Dateien wird hier Platz reserviert.

Eigenschaften und Funktionen der Klasse

Schreiben wir erst mal ein paar Eigenschaften in die Klasse, um die besagten Info's für Name, Beschreibung und Kommentar lesen und schreiben zu können:

Public Property Get DiscName() As String
  DiscName = Trim(GetFile(m_FileSystemName, 8, 15))
End Property
 
Public Property Let DiscName(ByVal sNewVal As String)
  Dim sTemp As String * 15
 
  sTemp = sNewVal
  SaveFile m_FileSystemName, sTemp, 8
End Property

Public Property Get DiscDescription() As String
  DiscDescription = Trim$(GetFile(m_FileSystemName, 23, 15))
End Property
 
Public Property Let DiscDescription(ByVal sNewVal As String)
  Dim sTemp As String * 15
 
  sTemp = sNewVal
  SaveFile m_FileSystemName, sTemp, 23
End Property

Public Property Get DiscComment() As String
  DiscComment = Trim$(GetFile(m_FileSystemName, 38, 14))
End Property
 
Public Property Let DiscComment(ByVal sNewVal As String)
  Dim sTemp As String * 14
 
  sTemp = sNewVal
  SaveFile m_FileSystemName, sTemp, 38
End Property

Sehr viel erklären muss man hier nicht; es werden lediglich die betreffenden Bytes ausgelesen bzw. wieder geschrieben; beim Schreiben wird der übergebene String auf die richtige Länge gebracht. Beachten müssen Sie allerdings: Irgendwo habe ich beim Programmieren einen Fehler reingebracht, deswegen kann der Kommentar nur 14 Zeichen umfassen - sollte allerdings reichen. Hier könnte man evtl. eine Datei angeben, die einen ausführlichen Text enthält.

Als Nächstes brauchen wir eine Funktion, um neue Verzeichnisse innerhalb unseres Dateisystems zu erstellen:

' InDir:         Angabe des Verzeichnisses
'                z. B. / (Rootdir) oder /hallo/du/
' NewFolderName: gibt den Namen des neuen Ordners an.
'                Maximale Länge: 32 Zeichen
' FolderLen:     legt fest, für wie viele Dateieinträge Platz '
'                reserviert wird.
'
' Beispiel: Sie wollen den Ordner /dir/test/ erstellen:
' AddDirectory "/dir/", "test"
Public Sub AddDirectory(ByVal sInDir As String, _
  ByVal sNewFolderName As String, _
  Optional ByVal nFolderLen As Long = 256, _
  Optional bSystemFile As Boolean)
 
  Dim sDir As String * 32
  Dim sTemp As String
  Dim nLen As Long
 
  sDir = sNewFolderName
  nLen = nFolderLen * 80&
  sTemp = IIf(bSystemFile, "V", "D") & sDir & _
    Format$(FileLen(m_FileSystemName) + 1, "0000000000") & _
    Format(nLen, "0000000000") & Space(25 + 2)
 
  AddEntryToList sInDir, sTemp
  sTemp = Space$(nLen)
  SaveFile m_FileSystemName, sTemp, FileLen(m_FileSystemName) + 1
End Sub

Hier wird der Eintrag für das neue Verzeichnis erzeugt und in die Dateitabelle (vergleichbar mit der MasterFileTable von NTFS) geschrieben; außerdem wird eine neue Dateitabelle für das Verzeichnis angelegt und hinten an die Datei angehängt. Die Länge der neuen Dateitabelle kann beliebig groß sein - der Parameter "FolderLen" bestimmt die Anzahl an möglichen Dateien in diesem Verzeichnis. Geben sie hier 10 an, ist es unmöglich, 11 Dateien in das Verzeichnis zu speichern. Als Dateien zählen hier auch Verzeichnisse.

sTemp = IIf(bSystemFile, "V", "D") & sDir & _
  Format$(FileLen(m_FileSystemName) + 1, "0000000000") & _
  Format(nLen, "0000000000") & Space(25 + 2)

Zuerst wird in die Variable sTemp ein Buchstabe gespeichert - V oder D. V steht dabei für ein Systemverzeichnis, welches später bei der DIR-Funktion nicht aufgelistet wird. Eigentlich ist es egal, was hier steht - überprüft wird das nicht.

Anschließend kommt der Dateiname; mittels zusätzlicher Leerzeichen auf exakt 32 Bytes gebracht. Danach kommen zwei mal 10 Bytes, um die exakte Lage und Länge anzugeben, dann noch 25 Leerzeichen. Hier sollte eigentlich mal eine Funktion hin, um den Dateien Kommentare zu geben, was ich bis jetzt aber noch nicht implementiert habe. Abschließend müssen noch 2 Leerzeichen herhalten, um den String auf 80 Bytes zu bekommen - 78 wollte ich nicht unbedingt nehmen

Anmerkung: Ich habe mich dafür entschieden, das Wurzelverzeichnis / zu nennen, und den Slash (/) als Pfadtrennzeichen.
Von daher: Verwenden sie dieses Zeichen nicht als Dateiname.
Es ist zwar möglich, gibt aber in Ordnernamen Probleme und kann - je nach Anwendung, die diese Klasse eingebunden hat - zu Abstürzen führen. Praktisch sollten Sie sich an Windows orientieren - was da gut ist, kann für die Klasse nicht schlecht sein. Theoretisch sind auch * und ? im Dateiname erlaubt.

Einträge speichern und lesen

Die Funktion AddEntryToList sucht einen freien Platz und schreibt schließlich den Eintrag in die Dateitabelle:

' Freien Platz suchen und Eintrag speichern
Private Sub AddEntryToList(ByVal sInDir As String, _
  ByVal sEntry As String)
 
  Dim nPos As Long
  Dim nLen As Long
  Dim bResult As Boolean
  Dim i As Long
  Dim sTemp As String
 
  bResult = False
  nPos = GetListPos(sInDir, nLen)
  For i = nPos To nLen + nPos Step 80
    sTemp = GetFile(m_FileSystemName, i, 3)
    If sTemp = "   " Then
      SaveFile m_FileSystemName, sEntry, i
      bResult = True
      Exit For
    End If
  Next i
 
  If Not bResult Then
    Err.Raise 5503, "FileStorage.AddEntryToList", _
      "Kein freier Platz in Verzeichnisliste"
  End If
End Sub

Falls kein Platz mehr ist, wird ein Fehler ausgelöst. Um die Dateitabelle selbst zu finden, brauchen wir noch folgende Funktion:

Private Function GetListPos(ByVal sOfDir As String, _
  ByRef nBufferLen As Long) As Long
 
  Dim vTemp As Variant
  Dim i As Long
  Dim bResult As Boolean
  Dim sTemp As String
  Dim L1 As Long
  Dim L2 As Long
  Dim sDir As String
  Dim u As Long
  Dim nLen As Long
 
  ' Slash entfernen
  If Left$(sOfDir, 1) = "/" Then sOfDir = Mid$(sOfDir, 2)
  If Right$(sOfDir, 1) = "/" Then sOfDir = Left$(sOfDir, Len(sOfDir) - 1)
 
  ' Wenn das Wurzelverzeichnis gesucht wird...
  ' Position ist immer gleich
  If Len(sOfDir) = 0 Then
    GetListPos = 52 ' 3*15+7
    nBufferLen = 512& * 80
  Else
    ' Pfadangabe aufteilen in einzelne Verzeichnisse
    vTemp = Split(sOfDir, "/")
    L1 = 512& * 80
    L2 = 52
    ' Von einem Verzeichnis zum nächsten durchhangeln:
    ' also: zuerst /dir/ suchen, dann innerhalb
    ' von /dir/ /test/ suchen...
    For i = 0 To UBound(vTemp)
      ' Verzeichnistabelle auslesen:
      bResult = False
      sTemp = GetFile(m_FileSystemName, L2, nLen)
      For u = 1 To Len(sTemp) Step 80
        sDir = Trim$(Mid$(sTemp, u + 1, 32))
        If LCase$(sDir) = LCase$(vTemp(i)) Then
          ' Verzeichnisposition gefunden: Merken...
          L2 = CLng(Mid$(sTemp, u + 33, 10))
          nLen = CLng(Mid$(sTemp, u + 43, 10))
          bResult = True
          Exit For       ' ... und nächste Verzeichnisebene suchen
        End If
      Next u
      If Not bResult Then
        Err.Raise 5502, "FileStorage.GetListPos", _
          "Datei/Verzeichnis nicht gefunden!"
      End If
    Next i
 
    ' Länge in den Buffer schreiben und Rest zurückgeben
    nBufferLen = nLen
    GetListPos = L2
  End If
End Function

nBufferLen gibt hierbei eine Buffer-Länge an, damit die aufrufende Prozedur auch die Länge der Dateiliste mitbekommt.

Mit Dateien kann man fast genauso umgehen wie mit Verzeichnissen:

' Fügt eine neue Datei dem Dateisystem hinzu
'
' InDir:       Beispielsweise /hallo/
' NewFileName: Dateiname
' FileContent: Dateiinhalt
Public Sub AddFile(ByVal sInDir As String, _
  ByVal sNewFileName As String, _
  ByVal sFileContent As String, _
  Optional ByVal bSystemFile As Boolean)
 
  Dim sDir As String * 32
  Dim sTemp As String
  Dim nLen As Long
 
  sDir = sNewFileName
  nLen = FileLen(m_FileSystemName) + 1
  sTemp = IIf(bSystemFile, "S", "F") & sDir & _
    Format$(nLen, "0000000000") & _
    Format$(Len(sFileContent), "0000000000") & Space$(25 + 2)
 
  AddEntryToList sInDir, sTemp
  SaveFile m_FileSystemName, sFileContent, nLen
End Sub

Die Arbeit ist eigentlich die Gleiche, nur dass hier eben keine Dateitabelle gespeichert wird, sondern der Dateiinhalt...

Nun noch eine Funktion, mit der man das Ganze wieder auslesen kann:

' Liest eine Datei aus
'
' InDir:    Beispielsweise /hallo/
' FileName: Dateiname
Public Function ReadFile(ByVal sInDir As String, _
  ByVal sFileName As String) As String
 
  Dim nPos As Long
  Dim nBufferLen As Long
 
  ' ggf. Slash hinzufügen
  If Right$(sInDir, 1) <> "/" Then sInDir = sInDir & "/"
  nPos = GetListPos(sInDir & sFileName, nBufferLen)
 
  ReadFile = GetFile(m_FileSystemName, nPos, nBufferLen)
End Function

Dateien werden im Dateisystem so gespeichert wie Verzeichnisse, nur dass die Positionsangaben nicht auf eine Dateiliste verweisen, sondern auf den Inhalt der Datei. Daher gestaltet sich das Auslesen relativ einfach - wir gaukeln den anderen Funktionen vor, wir wollten die Dateiliste...

Modifizieren von Dateien und Auslesen der Datei-/Verzeichnisstruktur

Zum Schluss noch eine Funktion, um Dateien zu modifizieren...

' Modifiziert den Inhalt einer Datei
Public Sub ModifyFile(ByVal sInDir As String, _
  ByVal sFileName As String, _
  ByVal sBuffer As String)
 
  Dim nPos As Long
  Dim nLen As Long
 
  nPos = GetFilePos(sInDir, sFileName)
  nLen = GetFileLen(sInDir, sFileName)
 
  If Len(sBuffer) > nLen Then sBuffer = Left$(sBuffer, nLen)
  If Len(sBuffer) < nPos Then _
    sBuffer = sBuffer & Space$(nLen - Len(sBuffer))
 
  SaveFile m_FileSystemName, sBuffer, nPos
End Sub

... und die benötigten Hilfsfunktionen:

' Gibt die Länge einer Datei zurück
Public Function GetFileLen(ByVal sInDir As String, _
  ByVal sFileName As String) As Long
 
  Dim nPos As Long
  Dim nLen As Long
 
  If Right$(sInDir, 1) <> "/" Then sInDir = sInDir & "/"
  nPos = GetListPos(sInDir & sFileName, nLen)
  GetFileLen = nLen
End Function

' Gibt die Position einer Datei zurück
Public Function GetFilePos(ByVal sInDir As String, _
  ByVal sFileName As String) As Long
 
  Dim nPos As Long
  Dim nLen As Long
 
  If Right$(sInDir, 1) <> "/" Then sInDir = sInDir & "/"
  nPos = GetListPos(sInDir & sFileName, nLen)
  GetFilePos = nPos
End Function

Eine Funktion, um herauszubekommen, ob bestimmte Dateien existieren, wäre auch nicht schlecht:

' Prüft ob eine Datei/Verzeichnis existiert.
' Gibt TRUE zurück, wenn ja
Public Function FileExists(ByVal sInDir As String, _
  ByVal sFileName As String) As Boolean
 
  Dim nPos As Long
  Dim nLen As Long
 
  On Error Resume Next
  Err.Clear
  If Right$(sInDir, 1) <> "/" Then sInDir = sInDir & "/"
  nPos = GetListPos(sInDir & sFileName, nLen)
  FileExists = (Err.Number = 0)
  On Error GoTo 0
End Function

DIR fehlt natürlich noch - dazu benötigen wir aber ganz oben unter Option Explicit noch die Deklaration:

Private tmpDIR As String

Hier die eigentliche Funktion - sie liest die Dateitabelle aus, speichert sie in einer reduzierten Version in der Variable tmpDir und gibt immer einen Dateinamen zurück. Anwendung fast wie die Originalfunktion von VB:

' Gibt den Verzeichnisinhalt zurück
Public Function Dir(Optional ByVal sInDir As String, _
  Optional ByVal sFileFilter As String, _
  Optional ByVal bWithDirectory As Boolean)
 
  Dim i As Long
  Dim sTemp As String
  Dim sDir As String
 
  If Len(sFileFilter) = 0 Then
    If Len(tmpDIR) = 0 Then
      Dir = vbNullString
    ElseIf InStr(1, tmpDIR, vbCrLf) <= 0 Then
      Dir = tmpDIR
      tmpDIR = vbNullString
    Else
      sTemp = tmpDIR
      sTemp = Left$(sTemp, InStr(1, sTemp, vbCrLf) - 1)
      tmpDIR = Mid$(tmpDIR, Len(sTemp) + 3)
      Dir = sTemp
    End If
 
  Else
    If Left$(sInDir, 1) <> "/" Then sInDir = "/" & sInDir
    If Right$(sInDir, 1) = "/" Then _
      sInDir = Left$(sInDir, Len(sInDir) - 1)
 
    If Len(sInDir) = 0 Then
      sDir = GetFile(m_FileSystemName, 52, 40960)
    Else
      sDir = Left$(sInDir, InStrRev(sInDir, "/") - 1)
      sTemp = Mid$(sInDir, Len(sDir) + 2)
      sTemp = ReadFile(sDir, sTemp)
    End If
 
    For i = 1 To Len(sTemp) Step 80
      sDir = Mid$(sTemp, i, 1)
      If (bWithDirectory And sDir = "D") Or sDir = "F" Then
        ' D Normales Verzeichnis
        ' F Normale Datei
        ' V Systemverzeichnis - nicht mit auflisten
        ' S Systemdatei  - nicht mit auflisten
        sDir = Trim$(Mid$(sTemp, i + 1, 32))
        If sDir Like sFileFilter Then tmpDIR = tmpDIR & sDir & vbCrLf
      End If
    Next i
 
    Dir = Me.Dir
  End If
End Function

Hier ein kleiner Beispielcode, um DIR einzusetzen:

Dim sDir As String
 
sDir = oFileSystem.Dir("/tempverzeichnis/", "*.bmp")
Do While len(sDir) > 0
  Msgbox sDir
  sDir = oFileSystem.Dir
Loop

Für oFileSystem müssen Sie den Namen der Objekt-Variable eingeben, welchen Sie bei der Instanzierung der Klasse verwendet haben.

Kleines Anwendungsbeispiel

Die Klasse eignet sich u.a. hervorragend für das Speichern von benutzerdefinierten Einstellungen. So können Sie für jeden Benutzer Ihres Programms einen "Benutzerordner" erstellen und darin dann die individuellen Einstellungen speichern und auslesen.

Neues Dateisystem erstrellen

Option Explicit
Dim oFileSystem As New clsFileSystem

Dim sFSFile As String

' Dateiname
sFSFile = App.Path & "\user.fs"
 
' Neues Dateisystem erstellen
With oFileSystem
  .CreateFS sFSFile
 
  ' Ordner erstellen
  AddDirectory "/", "User_1"
  AddDirectory "/", "User_2"
  AddDirectory "/", "User_3"  
End With

Einstellungen speichern

Dim sUser As String
 
' Einstellungen speichern ...
With oFileSystem
  ' ... für User 1
  sUser = "User_1"
  .AddFile sUser, "name", "Dieter Otter"
  .AddFile sUser, "email", "info@tools4vb.de"
  .AddFile sUser, "homepage", "www.tools4vb.de"
 
  ' ... für User 2
  sUser = "User_2"
  .AddFile sUser, "name", "Mustermann Karl"
  .AddFile sUser, "email", "info@muka.de"
  .AddFile sUser, "homepage", "www.muka.de"
 
  ...
End With

Einstellungen auslesen

Dim sName As String
Dim sEMail As String
Dim sHomepage As String
Dim sUser As String
 
With oFileSystem
  ' Dateisystem öffnen
  .OpenFS sFSFile
 
  ' Einstellungen User 1 auslesen
  sUser = "User_1"
  sName = .ReadFile(sUser, "name")
  sEMail = .ReadFile(sUser, "email")
  sHomepage = .ReadFile(sUser, "homepage")
 
  ...
End With

oFileSystem.AddFile "/", "Anmerkung", "viel Spaß!"