VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Historie
26.06.2001	Bestimmung des langen Dateinamens
20.12.2000	Erste Version: (rekursive) Durchsuchung eines Verzeichnisses

Im folgenden werden die Find*File-API-Routinen verwendet, um eine Liste aller Dateien gemäß einem Pattern zu suchen (FindFiles) bzw. den langen (Win32-)Dateinamen aus einem kurzen (DOS-)Pfad zu bestimmen (LongFilename).

Einleitung

Mit der unten stehenden Funktion FindFiles ist es möglich, einen Dateibaum gemäß eines Datei-Patterns (z.B. "*.txt") zu durchsuchen. Optional können erforderliche Datei-Attribute (s.a. GetAttr in der VB-Hilfe) angegeben werden. Mit dem Recursive-Parameter kann definiert werden, ob alle Unter-Verzeichnisse ebenfalls durchsucht werden sollen (Voreinstellung), oder nicht. Zurückgegeben wird die Anzahl der gefundenen Dateien.

Der Parameter Files enthält nach Funktions-Ausführung eine Collection aller gefundenen Dateien (mitsamt vollständigem Pfad). Die Funktion kann auch mehrmals hintereinander (mit unterschiedlichen Such-Parametern) aufgerufen werden; Dann werden alle neu gefundenen Dateien der Collection hinzugefügt.

Übrigens: Soll nur nach genau einer bestimmten Datei sehr schnell gesucht werden, genügt ein deutlich geringerer Aufwand (siehe FindFile).

Beispiel

Im folgenden Beispiel werden alle HTML-Dateien im Verzeichnis "D:\Tmp" angezeigt, welche mit "j" anfangen und das Archiv-Bit gesetzt haben. Man beachte, wie die beiden üblichen Datei-Endungen einfach durch "Hintereinander-Schaltung" berücksichtigt werden:

Dim Dateien As Collection
Dim i As Long

If FindFiles("D:\Tmp", Dateien, "j*.htm", vbArchive) _
    + FindFiles("D:\Tmp", Dateien, "j*.html", vbArchive) _
Then
  For i = 1 To Dateien.Count
    MsgBox Dateien(i)
  Next i
Else
  MsgBox "Nichts gefunden!"
End If

Alternativ kann auch folgende Variante genutzt werden:

Dim Dateien As Collection
Dim i As Long

FindFiles "D:\Tmp", Dateien, "j*.htm", vbArchive
FindFiles "D:\Tmp", Dateien, "j*.html", vbArchive
If Dateien.Count Then
  For i = 1 To Dateien.Count
    MsgBox Dateien(i)
  Next i
Else
  MsgBox "Nichts gefunden!"
End If

Code / Quelltext

Folgende API-Funktionen und -Deklarationen werden benötigt (müssem im Deklarationsteil des Moduls stehen):

Private Declare Sub FindClose Lib "kernel32" ( _
    ByVal hFindFile As Long)
Private Declare Function FindFirstFileA Lib "kernel32" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA _
  ) As Long
Private Declare Function FindNextFileA Lib "kernel32" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA _
  ) As Long
Private Declare Function GetFileAttributesA Lib "kernel32" ( _
    ByVal lpFileName As String _
  ) As Long

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 260
  cAlternate As String * 14
End Type

Hier nun die eigentliche Funktion:

Public Function FindFiles( _
    ByVal Path As String, _
    ByRef Files As Collection, _
    Optional ByVal Pattern As String = "*.*", _
    Optional ByVal Attributes As VbFileAttribute = vbNormal, _
    Optional ByVal Recursive As Boolean = True _
  ) As Long
  Const vbErr_PathNotFound = 76
  Const INVALID_VALUE = -1
  Dim FileAttr As Long
  Dim FileName As String
  Dim hFind As Long
  Dim WFD As WIN32_FIND_DATA
  
  'Initialisierung:
  If Right$(Path, 1) <> "\" Then _
      Path = Path & "\"
  If Files Is Nothing Then _
      Set Files = New Collection
  Pattern = LCase$(Pattern)
  
  'Suche starten:
  hFind = FindFirstFileA(Path & "*", WFD)
  If hFind = INVALID_VALUE Then _
      Err.Raise vbErr_PathNotFound
  
  'Suche fortsetzen:
  Do
    FileName = LeftB$(WFD.cFileName, _
        InStrB(WFD.cFileName, vbNullChar))
    FileAttr = GetFileAttributesA(Path & FileName)
    
    If FileAttr And vbDirectory Then
    
      'Verzeichnis analysieren:
      If Recursive Then
        If FileAttr <> INVALID_VALUE _
            And FileName <> "." And FileName <> ".." _
        Then
          FindFiles = FindFiles + FindFiles( _
              Path & FileName, Files, Pattern, Attributes)
        End If
      End If
    
    Else
    
      'Datei analysieren:
      If (FileAttr And Attributes) = Attributes Then
        If LCase$(FileName) Like Pattern Then
          FindFiles = FindFiles + 1
          Files.Add Path & FileName
        End If
      End If
    
    End If
  Loop While FindNextFileA(hFind, WFD)
  FindClose hFind
End Function

Langen Dateinamen bestimmen

Ein neben-Effekt der oben gezeigten Routine ist die Füllung der WIN32_FIND_DATA-Struktur mit dem langen (unter Win32 üblichen) Dateinamen, auch wenn die Suche mit einem kurzen (DOS-kompatiblen, also 8+3 Zeichen langen) Namen durchgeführt wurde. Auf das Notwendigste reduziert, ergibt sich folgender Code:

Public Function LongFilename( _
    ByRef FilePath As String) As String
  Const INVALID_VALUE = -1
  Dim hFind As Long
  Dim WFD As WIN32_FIND_DATA
  
  hFind = FindFirstFileA(FilePath, WFD)
  If hFind <> INVALID_VALUE Then
    LongFilename = LeftB$(WFD.cFileName, _
        InStrB(WFD.cFileName, vbNullChar))
    FindClose hFind
  End If
End Function

Eine Datei "D:\Test\Langer Name.txt" hat i.A. den Kurznamen "Langer~1.txt", also gibt LongFilename gerade den String "Langer Name.txt" zurück.

Übrigens: In "Lange Pfade in (kurze) DOS-Pfade" ist die Umkehrfunktion zu finden.