vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2020
 
zurück
Rubrik: Dateisystem · Dateien allgemein   |   VB-Versionen: VB4, VB5, VB612.02.01
Ermitteln aller Dateien eines Ordners/Unterordners

Hier wird gezeigt, wie alle Dateien eines Ordners inkl. der Dateien in vorhandenen Unterordner ermittelt werden können.

Autor:   LonelySuicide666Bewertung:     [ Jetzt bewerten ]Views:  51.640 
www.vbapihelpline.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Der nachfolgende Tipp zeigt, wie man nach bestimmten Dateien innerhalb eines bestimmten Ordners und den darin enthaltenen Unterordnern suchen kann. Das ganze erfolgt über die Windows-API Befehle FindFirstFile und FindNextFile. Die Suchroutine unterstützt desweiteren auch Wildcards (* oder ?). Die Ergebnisliste wird in einem ARRAY-Datenfeld gespeichert, welche dann leicht in einer Liste dargestellt werden kann.

' zunächst die benötigten API-Deklarationen
Private Declare Function FindFirstFile Lib "kernel32" _
  Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, _
  lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
  Alias "FindNextFileA" ( _
  ByVal hFindFile As Long, _
  lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
  ByVal hFindFile As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" _
  Alias "GetShortPathNameA" ( _
  ByVal lpszLongPath As String, _
  ByVal lpszShortPath As String, _
  ByVal cchBuffer As Long) As Long
 
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
 
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
  dwFileAttributes As Long ' Dateiattribute
  ftCreationTime As FILETIME ' Erstellungsdatum
  ftLastAccessTime As FILETIME ' Letzter Zugriff
  ftLastWriteTime As FILETIME ' Letzte Speicherung
  nFileSizeHigh As Long ' Größe (Hi)
  nFileSizeLow As Long ' Größe (Lo)
  dwReserved0 As Long ' bedeutungslos
  dwReserved1 As Long ' bedeutungslos
  cFileName As String * MAX_PATH ' Dateiname
  cAlternate As String * 14 ' 8.3-Dateiname
End Type
 
Public Type Datei
  Pfadname As String
  DosDateiname As String
  Dateiname As String
  ErstelltAM As FILETIME
  LetzterZugriff As FILETIME
  LetzeÄnderung As FILETIME
  DateiGröße As Long
  Atribute As Long
End Type
 
Public WasFound() As Datei
Public StopSearch As Boolean 
 
' Suchroutine: Wildcards sind erlaubt (*.*, ?, ect.)
Public Function FindFile(ByVal StartPath As String, _
  ByVal SearchSubfolder As Boolean, _
  ByVal File As String, _
  ByRef FileFound() As Datei)
 
  Dim hFile As Long
  Dim FileData As WIN32_FIND_DATA
  Dim Directories() As String
  Dim OnlyDirectories As Boolean
  Dim TmpFile As String
  Dim I As Integer
 
  DoEvents
 
 ' Evtl. Backslash entfernen
 If Right$(StartPath, 1) = "\" Then _
   StartPath = Left$(StartPath, Len(StartPath) - 1)
 
SearchOnlySubfolders:
 
  ' Sucht nach einer Datei, und packt das
  ' Ergebnis in FileData
  hFile = FindFirstFile(StartPath & "\" & File & _
    vbNullChar, FileData)
 
  ' Wenn sie gefunden wurde, dann...
  If hFile <> INVALID_HANDLE_VALUE Then
 
    Do
      ' Ist es ein Verzeichniss oder eine Datei ?
      With FileData
        If (.dwFileAttributes And vbDirectory) = 0 Then
          ' Datei
 
          ' Nur wenn nicht nur Verzeichinsse gesucht werden
          If Not OnlyDirectories Then
            ' Array vergrößern und Daten ins Array schreiben
            On Error GoTo Err_DimFile
            ReDim Preserve FileFound(UBound(FileFound) + 1)
            On Error GoTo 0
 
            DoEvents
            UmPacken FileFound(UBound(FileFound)), _
              FileData, StartPath & "\" & File
 
          End If
          If StopSearch = True Then Exit Function
 
        ElseIf SearchSubfolder = True Then
          ' Verzeichnis
 
          ' Verzeichnis nur im Array Speichern wenn es
          ' über dem jetzigen liegt d.h. ".." "." sind
          ' nicht gültig
          If Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) <> "." _
            And Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) <> ".." Then
 
            On Error GoTo Err_DimDir
            ReDim Preserve Directories(UBound(Directories) + 1)
            On Error GoTo 0
 
            ' Verzeichnis dem Array hinzufügen
            Directories(UBound(Directories)) = _
              Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1)
          End If
 
        End If
      End With
      DoEvents
    Loop Until FindNextFile(hFile, FileData) = 0 Or StopSearch = True
  End If
  FindClose hFile
 
  ' Unteroder durchsuchen
  On Error GoTo Err_DimDir
  If SearchSubfolder = False Or _
    StopSearch = True Then Exit Function
  On Error GoTo 0
 
  ' Wenn nach anderen Dateien als *.* gesucht wird,
  ' werden keine Ordner gefunden
  ' Deshalb noch einmal gezielt nach Ordnern suchen
  If Not OnlyDirectories And SearchSubfolder = True And _
    File <> "*.*" Then
 
    OnlyDirectories = True
    TmpFile = File
    File = "*.*"
    GoTo SearchOnlySubfolders
  ElseIf TmpFile <> "" Then
    File = TmpFile
  End If
 
  On Error GoTo Err_Exit
  For I = 0 To UBound(Directories)
    If StopSearch = True Then Exit Function
    DoEvents
 
    ' Hier ruft die Funktion sich selbst auf - für
    ' jeden Unterordner
    FindFile StartPath & "\" & Directories(I), _
      SearchSubfolder, File, FileFound
  Next I
  Exit Function
 
Err_DimFile:
   ReDim FileFound(0)
   Resume Next
 
Err_DimDir:
   ReDim Directories(0)
   Resume Next
 
Err_Exit:
End Function
 
' Packt die Infos um und schneidet Nullchar-Zeichen ab
Private Function UmPacken(ByRef D As Datei, _
  FD As WIN32_FIND_DATA, ByVal Path As String)
 
  With FD
    D.Atribute = .dwFileAttributes
    D.DateiGröße = .nFileSizeLow
    D.Dateiname = Left$(.cFileName, InStr(.cFileName, _
      vbNullChar) - 1)
    D.DosDateiname = Left$(.cAlternate, _
      InStr(.cAlternate, vbNullChar) - 1)
    If D.DosDateiname = "" Then _
      D.DosDateiname = D.Dateiname
    D.ErstelltAM = .ftCreationTime
    D.LetzeÄnderung = .ftLastWriteTime
    D.LetzterZugriff = .ftLastAccessTime
    D.Pfadname = Left$(Path, InStrRev(Path, "\"))
  End With
End Function

Beispiel:
Nachfolgend ein kleines Anwendungsbeispiel, um z.B. alle Dateien des Ordners c:\windows\media auszulesen. Berücksichtigt werden auch alle evtl. vorhandenen Unterordner.

Public Sub StartS()
  Dim Dateien() As Datei
  StopSearch = False
  FindFile "C:\Windows\Media", True, "*.*", Dateien
 
  ' Ergebnisliste in Form1.List1 ausgeben
  Form1.List1.Clear
  For i = 0 To UBound(Dateien)
    Form1.List1.AddItem Dateien(i).Dateiname
  Next i
End Sub
 
' Und stoppen kann man das ganze hier
Public Sub StopS()
  StopSearch = True
End Sub

Dieser Tipp wurde bereits 51.640 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2020 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel