Dateifunktionen

Einleitung  

In den Methoden für die Verwaltung von Textdateien werden Dateien über Binary eingelesen. Das ist die absolut schnellste Methode und reicht bei Dateien von einigen MB völlig aus. Die folgenden Funktionen sind als Methoden in einer Klasse gekapselt, die projektweit oder auch auf Formebene angebunden werden kann. Natürlich sind die Funktionen auch einzeln einbindbar, jedoch setzen einige Funktionen sog. Grundfunktionen voraus.

Initialisieren  

Die Initialisierung sollte auf Projektebene in einem Modul erfolgen. Damit können die Methoden im ganzen Projekt genutzt werden.

'###############################################
'   Module1 zu FileFunctions
'-----------------------------------------------

Option Explicit

'FileFunctions generieren
Public cFF As New clsFileFunctions

Function ExistFile  

Mit der Function Dir kann die Existenz einer Datei leicht überprüft werden. Versteckte Dateien müssen zusätzlich über das Flag vbHidden geprüft werden.

Public Function ExistFile(FileName As String, _
    Optional Hidden As Boolean = False) As Boolean
'prüft die Existenz einer Datei

    If Hidden Then
        If Len(Dir(FileName, vbHidden)) > 0 Then
            ExistFile = True
        End If
    Else
        If Len(Dir(FileName)) > 0 Then
            ExistFile = True
        End If
    End If
End Function

' Einsatz der Function im Code

If cFF.ExistFile("c:\test\test.txt") Then
    'Verarbeitung ohne Hidden Files
End If
If cFF.ExistFile("c:\test\test.txt", True) Then
    'Verarbeitung mit Hidden Files
End If

Es gibt natürlich viele Möglichkeiten, die Existenz einer Datei zu überprüfen. Als Alternative kann z.B. folgende Funktion verwendet werden:

Public Function FileExists(Path As String) As Boolean
  Const NotFile = vbDirectory Or vbVolume

  On Error Resume Next
    FileExists = (GetAttr(Path) And NotFile) = 0
  On Error Goto 0
End Function


Sub Form_Load()
' Einsatz der Funktion
    If FileExists("D:\test.txt") Then MsgBox "Vorhanden"
End Sub

Quelle: Jost Schwider, VB-Tec.de
http://vb-tec.de/fdexists.htm

Hier entfällt die Überprüfung, ob es sich um versteckte, schreibgeschützte oder Systemdateien handelt. Mit dieser Funktion werden alle Dateien berücksichtigt.

Function ExistFolder  

Analog der Function ExistFile wird die Function ExistFolder zur Überprüfung von (versteckten) Ordnern eingesetzt. Die Dir Function wird hier mit dem Flag vbDirectory genutzt.

Public Function ExistFolder(FolderName As String, _
    Optional Hidden As Boolean = False) _
    As Boolean
    'prüft die Existenz eines Verzeichnisses

    If Hidden Then
        If Len(Dir(FolderName, vbHidden + vbDirectory)) > 0 Then
            ExistFolder = True
        End If
    Else
        If Len(Dir(FolderName, vbDirectory)) > 0 Then
            ExistFolder = True
        End If
    End If
End Function

Function FileIsOpened  

Häufig muss gerade in Netzwerken geprüft werden, ob eine bestimmte Datei von einer anderen Anwendung geöffnet ist. Bei der hier vorgestellten Technik wird versucht, die Datei über Lock Read Write zu öffnen und damit für andere Anwendungen zu sperren. Wenn die Datei aber bereits von einem anderen Programm geöffnet ist, schlägt der Lock Versuch fehl.

Viele Editoren lesen eine Datei lediglich aus und schliessen sie sofort wieder um sie bei einer Änderung anschliessend einfach zu überschreiben. In diesen Fällen bleibt die Function ohne Wirkung. Im Office Bereich funktioniert das aber.

Public Function FileIsOpened(FileName As String) As Boolean
'prüft ob eine Datei (von einem anderen Programm) geöffnet ist

   Dim FNr As Integer
   
      If Not ExistFile(FileName) Then
         Exit Function
      End If
      
      On Error Goto Fehler
      FNr = FreeFile
      Open FileName For Input Lock Read Write As #FNr
      Close #FNr
      Exit Function
         
Fehler:
      FileIsOpened = True
End Function

Function ReadToString  

Die Function ReadToString liefert den Inhalt einer (Text) Datei als String. Eine Überprüfung der Datei findet dabei nicht statt, das sollte vorher mit ExistFile erfolgen. Bei der verwendeten Technik wird die Datei binär geöffnet, ein String in der Länge der Datei mit Leerstellen (Spaces) initialisiert und der Dateiinhalt über Get in den String ausgelesen.

Gerade bei grösseren Dateien ist es sinnvoll dabei die Sanduhr anzuzeigen. Über ErrNumber kann ein eventuell aufgetretener Fehler abgefragt werden.

Public Function ReadToString(Filename As String, _
                             Optional ErrNumber As Long, _
                             Optional ErrDescription As String, _
                             Optional ShowHourGlass As _
                             Boolean = True) As String
'liefert den Inhalt einer Datei in einem String

   Dim FNr As Integer
   Dim s As String

      'Set MousePointer to HourGlass
      SetMousePointerHourGlass ShowHourGlass
      
      ErrNumber = 0
      ErrDescription = ""
      
      On Error Goto Fehler
      
      'Datei einlesen
      FNr = FreeFile
      Open Filename For Binary As #FNr
          s = Space$(LOF(FNr))
          Get #FNr, , s
      Close #FNr
      ReadToString = s
     
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      Exit Function
      
Fehler:
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      ErrNumber = Err.Number
      ErrDescription = Err.Description
End Function

Beispiel für die Verwendung der Function:

Text1.Text = cFF.ReadToString("c:\test\test.txt", _
    ErrNumber, ErrDescription)

Function ReadToLines  

Die Function ReadToLines liefert den Inhalt einer Textdatei in einem 1-dimensionalen (Zeilen) Array. Hierbei wird der von der Function ReadToString gelieferte String über Split zeilenweise in ein Array gestellt. Als Zeilentrenner wird der in der Dos/Windows Welt übliche CrLf vorausgesetzt. (CarriageReturn/LineFeed &H0D0A oder Chr(13) & Chr(10)).

Public Function ReadToLines(FileName As String, _
                            Optional ErrNumber As Long, _
                            Optional ErrDescription As String, _
                            Optional ShowHourGlass As _
                            Boolean = True) As String()
'liefert den Inhalt einer Datei in einem (Zeilen) Array

   Dim s As String
   Dim s1() As String
      
      ReDim s1(0)
      
      'Datei in String einlesen
      s = ReadToString(Filename, ErrNumber, ErrDescription, _
                                            ShowHourGlass)
      'aufdröseln in Array
      If ErrNumber = 0 Then
         s1() = Split(s, vbCrLf)
      End If
      
      ReadToLines = s1()
End Function

Verwendung der Function:

Dim s() As String
Dim i As Long

If ErrNumber = 0 Then
   s() = cFF.ReadToLines("c:\test\test.txt", _
                          ErrNumber, ErrDescription)
   For i = LBound(s) To UBound(s)
      Debug.Print s(i)
   Next
End If

Function ReadToArray  

Wesentlich aufwendiger ist die Function ReadToArray gestaltet, die den Inhalt einer Datei in einem 2-dimensionalen Array liefert. Bei der Speicherung von Adressendaten in einer Textdatei oder bei einem Datenaustausch über Textfiles bietet sich diese Funktion an.

Die einzelnen Zeilen sind durch CrLf getrennt, die Felder in den Zeilen durch einen eigenen frei wählbaren Separator. Dafür wird häufig das Komma, der Strichpunkt oder ein Tab eingesetzt.

Public Function ReadToArray(FileName As String, _
                            Separator As String, _
                            Optional ErrNumber As Long, _
                            Optional ErrDescription As String, _
                            Optional ShowHourGlass As _
                            Boolean = True) As String()
'liefert den Inhalt einer Datei in einem mehrdimensionalen Array

   Dim s As String
   Dim s1() As String
   Dim s2() As String
   Dim s3() As String
   Dim i As Long
   Dim j As Long
   
'Datei einlesen
      s = ReadToString(Filename, ErrNumber, ErrDescription, _
                                            ShowHourGlass)
      If ErrNumber <> 0 Then
         ReDim s2(0)
         ReadToArray = s2()
         Exit Function
      End If
      
      'Set MousePointer
      SetMousePointerHourGlass ShowHourGlass
      
      'aufteilen in Zeilen
      s1() = Split(s, vbCrLf)
      'Anzahl der Elemente ermitteln
      i = UBound(Split(s1(UBound(s1)), Separator))
      If i = 0 Then
         'ist 1.dimensional
         ReadToArray = s1()
         'ReSave MousePointer
         SetMousePointerDefault ShowHourGlass
         Exit Function
      End If
      
      '2-dimensionales Array aufbauen
      ReDim s2(0 To i, LBound(s1) To UBound(s1))
      For i = LBound(s1) To UBound(s1)
         s3() = Split(s1(i), Separator)
         For j = LBound(s3) To UBound(s3)
            s2(j, i) = s3(j)
         Next
      Next
      
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      ReadToArray = s2()
End Function

Beispiel für einen Aufruf:

Dim s() As String

s() = cFF.ReadToArray("c:\test\test.txt", ";", ErrNumber, _
                      ErrDescription)

Function PutString  

Über die Funktion PutString wird der Inhalt eines Strings in eine Textdatei geschrieben. Das kann zum Beispiel der Inhalt einer Textbox sein.

Die Datei wird dabei For Output geöffnet, geschrieben wird mit der Anweisung Print. Ein nachfolgender Strichpunkt verhindert, dass ein zusätzlicher CrLf an das Ende der Datei geschrieben wird.

Public Function PutString(FileName As String, _
                          sString As String, _
                          Optional ErrNumber As Long, _
                          Optional ErrDescription As String, _
                          Optional ShowHourGlass As _
                          Boolean = True) As Boolean
'schreibt einen String in eine Datei

   Dim FNr As Integer

      'Set MousePointer
      SetMousePointerHourGlass ShowHourGlass
     
      'String in Datei ausgeben
      On Error Goto Fehler
      FNr = FreeFile
      Open Filename For Output As #FNr
      Print #FNr, sString;
      Close #FNr
      PutString = True
      
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      Exit Function
      
Fehler:
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      ErrNumber = Err.Number
      ErrDescription = Err.Description
End Function

Beispiel für eine Anweisung:

If cFF.PutString("c:\test\test.txt", Text1.Text, _
                 ErrNumber, ErrDescription) Then
   Exit Sub
End If

Function PutLines  

Mit PutLines wird der Inhalt eines 1-dimensionalen Arrays in eine Textdatei geschrieben. Dabei wird der Inhalt übergebenen Arrays über Join zu einem String zusammengefügt mit CrLf als Zeilentrenner und der String über PutString in die Datei geschrieben.

Join bietet sich hier hervorragend an, da diese Funktion auf niedrigster Ebene läuft und deshalb sehr schnell ist.

Public Function PutLines(FileName As String, _
                         sLines() As String, _
                         Optional ErrNumber As Long, _
                         Optional ErrDescription As String, _
                         Optional ShowHourGlass As _
                         Boolean = True) As Boolean
'schreibt einen ein (Zeilen) Array in eine Datei

Dim s As String

      s = Join(sLines(), vbCrLf)
      If PutString(Filename, s, ErrNumber, ErrDescription, _
                                ShowHourGlass) Then
         PutLines = True
         Exit Function
      End If
      
End Function

Beispiel für einen Aufruf:

If cFF.PutLines("c:\test\test.txt", s(), ErrNumber, _
                                         ErrDescription) Then
   Exit Sub
End If

Function PutArray  

Beim Schreiben eines 2-dimensionalen Arrays über PutArray wird eine etwas andere Technik verwendet. Das Schreiben der Daten in die Datei erfolgt zeilenweise, wobei die Elemente zuerst in ein Workarray übergeben werden und aus diesem Workarray per Join ein String mit eingestreuten (Feld) Separatoren gebildet wird.

Diese Methode dürfte optimal in Bezug auf Geschwindigkeit sein, da Stringoperationen mit veränderter Stringlänge in Basic im Allgemeinen nicht schnell sind.

Public Function PutArray(Filename As String, _
                         sArray() As String, _
                         Separator As String, _
                         Optional ErrNumber As Long, _
                         Optional ErrDescription As String, _
                         Optional ShowHourGlass _
                         As Boolean = True) As Boolean
'schreibt einen ein mehrdimensionales Array in eine Datei

   Dim Work() As String
   Dim FNr As Integer
   Dim Ele As Long
   Dim i As Long
   Dim j As Long
   Dim CursorNumber As Long
   
      'Set MousePointer
      SetMousePointerHourGlass ShowHourGlass
  
      'Anzahl der Elemente pro Zeile ermitteln
      Ele = UBound(sArray, 1) - LBound(sArray, 1) + 1
      
      On Error Goto Fehler
      
      'Zieldatei öffen
      FNr = FreeFile
      Open Filename For Output As #FNr
      'in Schleife alle Element aus Dimension 2 abarbeiten
      For i = LBound(sArray, 2) To UBound(sArray, 2)
         'Dimension 1 übertragen
         ReDim Work(LBound(sArray, 1) To UBound(sArray, 1))
         For j = LBound(sArray, 1) To UBound(sArray, 1)
            Work(j) = sArray(j, i)
         Next
         'Zeile ausgeben in Datei
         If i < UBound(sArray, 2) Then
            'ausgeben mit CrLf
            Print #FNr, Join(Work(), Separator)
         Else
            'letzte Zeile ohne CrLf
            Print #FNr, Join(Work(), Separator);
         End If
      Next
      'Datei schliessen
      Close #FNr
      
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      PutArray = True
      Exit Function
      
Fehler:
      'ReSave MousePointer
      SetMousePointerDefault ShowHourGlass
      ErrNumber = Err.Number
      ErrDescription = Err.Description
End Function

Aufruf der Funktion:

If cFF.PutArray("c:\test\test.txt", s(), Separator, ErrNumber, _
                ErrDescription) Then
   Exit Sub
End If

Function LineInsert  

Häufig ist es nötig, in einem 1-dimensionalen Array ein Element (Zeile) an einer bestimmten Position einzufügen. Das wird mit LineInsert realisiert.

Seit VB6 kann ein Array über Redim Preserve in seiner Grösse verändert werden ohne dass der Inhalt verlorengeht. In der vorgestellten Funktion wird zuerst das Array um 1 Element vergrössert, der Inhalt ab der Position des Einfügens bis zum Ende verschoben und dann ein (Leer) String als Element eingefügt.

Public Function LineInsert(LineNumber As Long, _
                           sLines() As String, _
                           Optional sString As String = "") _
                           As Boolean
'fügt eine Zeile in ein ZeilenArray ein

   Dim i As Long
   
      i = LineNumber
      'LineNumber darf nicht kleiner als Untergrenze sein
      If i < LBound(sLines) Then
         Exit Function
      'LineNumber darf nicht grösser sein als Obergrenze
      'Array + 1
      ElseIf i > (UBound(sLines) + 1) Then
         Exit Function
      ElseIf i < LBound(sLines) Then
         '1 Zeile anhängen, füllen, verlassen
         ReDim Preserve sLines(i)
         sLines(i) = sString
         LineInsert = True
         Exit Function
      End If
      
      'Array um 1 Element erweitern
      ReDim Preserve sLines(UBound(sLines) + 1)
      'Zeileninhalte verschieben
      For i = UBound(sLines) To LineNumber Step -1
         If i = 0 Then
            'Zeile 0 kann nicht mehr verschoben werden
            Exit For
         End If
         sLines(i) = sLines(i - 1)
      Next
      'eingefügte Zeile füllen
      sLines(LineNumber) = sString
      
      LineInsert = True
End Function

Beispiel für einen Aufruf:

If Not cFF.LineInsert(5, sLines(), Result) Then
   MsgBox "Funktion nicht ausgeführt", , "LineInsert"
   Exit Sub
End If

Function LineRemove  

Über LineRemove kann ein Element aus einem 1-dimensionalen Array entfernt und das Array um 1 Element verkleinert werden. Ab dem zu entfernenden Element wird der Inhalt der folgenden Elemente jeweils um 1 nach vorn verschoben, anschliessend das letzte Element durch Verkleinerung des Arrays um 1 entfernt.

Public Function LineRemove(LineNumber As Long, _
                           sLines() As String) As Boolean
'entfernt eine Zeile aus einem ZeilenArray

Dim i As Long
   
      i = LineNumber
      'LineNumber muss zwischen Unter- und Obergrenze liegen
      If LineNumber > UBound(sLines) Then
         Exit Function
      ElseIf LineNumber < LBound(sLines) Then
         Exit Function
      End If
      
      'ein Array mit einer Zeile ist nicht gültig
      If LBound(sLines) = UBound(sLines) Then
         Exit Function
      End If
      
      'verschieben der Zeileninhalte
      For i = LineNumber To UBound(sLines) - 1
         sLines(i) = sLines(i + 1)
      Next
      
      'letztes Element entfernen
      i = UBound(sLines) - 1
      ReDim Preserve sLines(i)
      
      LineRemove = True
End Function

Aufruf der Funktion:

If Not cFF.LineRemove(5, sLines()) Then
   MsgBox "Funktion nicht ausgeführt", , "LineRemove"
   Exit Sub
End If

Function LineUpdate  

Mit LineUpdate kann gezielt eine Zeile in einer Textdatei überschrieben werden, Voraussetzung ist natürlich, dass die Nummer der Zeile (beginnend ab Null) bekannt ist.

Public Function LineUpdate(LineNumber As Long, _
                           sLines() As String, _
                           sString As String) As Boolean
'ersetzt den Inhalt einer Zeile in einem ZeilenArray

   Dim i As Long
   
      i = LineNumber
      'LineNumber muss zwischen Unter- und Obergrenze liegen
      If LineNumber > UBound(sLines) Then
         Exit Function
      ElseIf LineNumber < LBound(sLines) Then
         Exit Function
      End If

      sLines(i) = sString
      LineUpdate = True
End Function

Beispiel für Update, Insert und Remove sollten ähnlich aufgerufen werden:

Private Sub Command1_Click()

   Dim Filename As String
   Dim s() As String
   Dim ErrNumber As Long
   Dim ErrDescription As String
   
      Filename = "c:\test\test.txt"
      
      'Datei einlesen
      s() = cFF.ReadToLines(Filename, ErrNumber, _
                                      ErrDescription)
      If ErrNumber <> 0 Then
         cFF.FehlerAnzeige ErrNumber, ErrDescription
         Exit Sub
      End If
      
      'Zeile überschreiben
      If Not cFF.LineUpdate(5, s(), "Neuer Text") Then
         MsgBox "Aktion konnte nicht ausgeführt werden"
         Exit Sub
      End If

      'Datei schreiben
      If Not cFF.PutLines(Filename, s(), ErrNumber, _
                          ErrDescription) Then
         cFF.FehlerAnzeige ErrNumber, ErrDescription
      End If
End Sub

Function FileNamesFromFolder  

Für das Auslesen von Dateinamen aus Verzeichnissen gibt es verschiedene Methoden, von API über FSO, auch das Steuerelement FileList. Die hier vorgestellte Funktion bedient sich der Dir Methode, wobei über Pattern alle Dateien, Dateien mit einer bestimmten Dateierweiterung sowie Dateien mit verschiedenen Erweiterungen (z.B. Grafik) berücksichtigt werden.

Zusätzlich kann noch angegeben werden, ob auch versteckte (Hidden) Files ausgewählt werden sollen. Das Ergebnis wird in einem Array zurückgegeben.

Public Function FileNamesFromFolder(Folder As String, _
                                    Pattern As String, _
                                    sArray() As String, _
                                    Optional Hidden As _
                                    Boolean = False) As Long
'ein Verzeichnis auslesen, Beispiel
'FileNamesFromFolder "c:\test", "*.bmp;*.jpg", s()

   Dim s As String, s1() As String
   Dim f As String
   Dim i As Long, j As Long
   Dim z As Long
   Dim p() As String

      ReDim sArray(0)

      'Pattern aufteilen auf Array, reine Endung
      p = Split(UCase(Replace(Pattern, "*.", "")), ";")

      f = Folder
      If Right(f, 1) <> "\" Then
         f = f & "\"
      End If
      'alle Dateien suchen
      If Hidden Then
         'auch versteckte
         s = Dir(f & "*.*", vbHidden)
      Else
         'keine versteckten
         s = Dir(f & "*.*")
      End If
      z = 0
      Do
         If Len(s) = 0 Then
            'durch
            Exit Do
         End If
         'keine Directorys
         If (GetAttr(f & s) And vbDirectory) _
            <> vbDirectory Then
            'keine Systemfiles
            If (s <> ".") And (s <> "..") Then
               'Dateiendung isolieren
               s1() = Split(UCase(s), ".")
               If UBound(s1) > 0 Then
                  'alle vorgegebenen Pattern durchlaufen
                  For j = LBound(p) To UBound(p)
                     If (p(j) = "*") Or (p(j) = _
                                     s1(UBound(s1))) Then
                        'gefunden
                        ReDim Preserve sArray(z)
                        sArray(z) = s
                        z = z + 1
                        Exit For
                     End If
                  Next
               End If
            End If
         End If
         s = Dir()
      Loop
      FileNamesFromFolder = z
End Function

Function FolderNamesFromFolder  

Die Funktion FolderNamesFromFolder bedient sich der gleichen Technik wie die Funktion FileNamesFromFolder.

Public Function FolderNamesFromFolder(Folder As String, _
                                      sArray() As String, _
                                      Optional Hidden As _
                                      Boolean = False) As Long
'Verzeichnisnamen eines Folders auslesen

   Dim f As String
   Dim s As String
   Dim z As Long

      f = Folder
      If Right(f, 1) <> "\" Then
         f = f & "\"
      End If
      
      'alle Dateien suchen
      If Hidden Then
         s = Dir(f, vbDirectory + vbHidden)
      Else
         s = Dir(f, vbDirectory)
      End If
         
      z = 0
      Do
         If Len(s) = 0 Then
            'durch
            Exit Do
         End If
         If (GetAttr(f & s) And vbDirectory) = vbDirectory Then
            If Left(s, 1) <> "." Then
               ReDim Preserve sArray(z)
               sArray(z) = s
               z = z + 1
            End If
         End If
         s = Dir()
      Loop
      FolderNamesFromFolder = z
End Function

Schlusswort  

Mit Hilfe der hier vorgestellten Funktionen sollte es Ihnen möglich sein, umfangreiche Dateimanipulationen durchzuführen. Durch die Kapselung der Funktionen in einer Klasse ist die leichte Portierbarkeit gewährleistet.

Word-Dokument und Beispiel zum Download [49734 Bytes]

Ihre Meinung  

Falls Sie Fragen zu diesem Tutorial haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.