VB 5/6-Tipp 0266: Verzeichnis mittels API auslesen
von Henrik Ilgen
Beschreibung
Die Dir-Funktion kann zwar alles, was dieser Tipp auch zu leisten vermag, über die Geschwindigkeitsvorteile lässt sich bestimmt ebenso streiten, allerdings liegen hier alle wesentlichen Informationen eines Verzeichniseintrages konkret in einem Variablentypen vor, was oft von großem Vorteil ist.
Update vom 06.06.'10: Die Prüfung, ob FindFirstFile() erfolgreich war, wurde korrigiert.
Update vom 07.06.'10: Der Tipp wurde komplett überarbeitet und ist jetzt besser gekapselt, sodass die Hauptfunktion direkt in andere Projekte übernommen werden kann.
Update am 06.02.2012: Dieser Tipp wurde von Henrik Ilgen mithilfe des Tippuploads überarbeitet und ersetzt.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: FindClose, FindFirstFileA (FindFirstFile), FindNextFileA (FindNextFile) | Download: |
' Dieser Quellcode stammt von http://www.activevb.de ' und kann frei verwendet werden. Für eventuelle Schäden ' wird nicht gehaftet. ' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. ' Ansonsten viel Spaß und Erfolg mit diesem Source! ' ------------- Anfang Projektdatei Project1.vbp ------------- ' ------- Anfang Formular "frmMain" alias frmMain.frm ------- ' Steuerelement: Listen-Steuerelement "lstResults" Option Explicit Private Sub Form_Load() Dim FoundFiles As modAPI.SearchResult Dim FileName As String Dim n As Long If modAPI.GetFiles("C:\*.*", FoundFiles) Then Me.Caption = CStr(FoundFiles.FileCount) & " Dateien und " & CStr( _ FoundFiles.FolderCount) & " Ordner gefunden." For n = 0 To FoundFiles.FolderCount - 1 FileName = Left$(FoundFiles.Folders(n).cFileName, InStr(1, _ FoundFiles.Folders(n).cFileName, vbNullChar) - 1) Call lstResults.AddItem("\" & FileName) Next n For n = 0 To FoundFiles.FileCount - 1 FileName = Left$(FoundFiles.Files(n).cFileName, InStr(1, _ FoundFiles.Files(n).cFileName, vbNullChar) - 1) Call lstResults.AddItem(FileName) Next n Else Me.Caption = "Suche ist fehlgeschlagen/Keine Suchergebnisse" End If End Sub ' -------- Ende Formular "frmMain" alias frmMain.frm -------- ' ---------- Anfang Modul "modAPI" alias modAPI.bas ---------- Option Explicit Private Declare Function FindFirstFile Lib "kernel32" _ Alias "FindFirstFileA" ( _ ByVal lpFileName As String, _ ByRef lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" _ Alias "FindNextFileA" ( _ ByVal hFindFile As Long, _ ByRef lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" ( _ ByVal hFindFile As Long) As Long Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Const INVALID_HANDLE_VALUE = -1 Private Const MAX_PATH = 260 Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public 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 * MAX_PATH cAlternate As String * 14 End Type Public Type SearchResult Folders() As WIN32_FIND_DATA Files() As WIN32_FIND_DATA FolderCount As Long FileCount As Long End Type Public Function GetFiles(ByVal SearchPattern As String, ByRef Result As _ SearchResult) As Boolean Dim FileName As String Dim FolderCount As Long Dim FileCount As Long Dim hSearch As Long Dim FindData As WIN32_FIND_DATA hSearch = FindFirstFile(SearchPattern, FindData) If hSearch = INVALID_HANDLE_VALUE Then ' Suche ist fehlgeschlagen (bspw. keine Suchergebnisse). False ' zurückgeben und Funktion verlassen. GetFiles = False Exit Function End If ReDim Result.Files(100) ReDim Result.Folders(100) Do If (FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then ' Es handelt sich um einen Ordner Result.Folders(FolderCount) = FindData FolderCount = FolderCount + 1 ' Muss zusätzlicher Platz geschaffen werden? If FolderCount > UBound(Result.Folders) Then ReDim Preserve Result.Folders(FolderCount + 100) End If Else ' Es handelt sich um eine Datei Result.Files(FileCount) = FindData FileCount = FileCount + 1 ' Muss zusätzlicher Platz geschaffen werden? If FileCount > UBound(Result.Files) Then ReDim Preserve Result.Files(FileCount + 100) End If End If Loop While FindNextFile(hSearch, FindData) <> 0 ' Such-Handle schließen Call FindClose(hSearch) If FolderCount > 0 Then ' Wenn Ordner gefunden wurden, Array zurechtschneiden ReDim Preserve Result.Folders(FolderCount - 1) Else ' Wenn keine Ordner gefunden wurden, Array löschen Erase Result.Folders End If If FileCount > 0 Then ' Wenn Dateien gefunden wurden, Array zurechtschneiden ReDim Preserve Result.Files(FileCount - 1) Else ' Wenn keine Dateien gefunden wurden, Array löschen Erase Result.Files End If ' Anzahl gefundener Ordner und Dateien setzen Result.FolderCount = FolderCount Result.FileCount = FileCount GetFiles = True End Function ' ----------- Ende Modul "modAPI" alias modAPI.bas ----------- ' -------------- Ende Projektdatei Project1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel 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.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Peter am 14.09.2007 um 11:24
Es wäre schön, wenn in der Beschreibung erscheinen würde, nach welchen Kriterien die Auflistung erfolgt.
Dann müsste man nicht erst den Quellcode lesen ;-)
Kommentar von Flotzi am 13.05.2006 um 19:00
Hi Leute ich hätte zu dem Tip ne frage!
Wie unterbinde ich es das es nicht nach dem alphabet geordnet wird? und die ordner an erster stelle sten!
wenn ihr ne Lösung habt schreibt mir bitte!!
Danke für Antworten im Vorraus!
icqnummer: 214170436
email: blitzprogrammierer@gmx.de
Kommentar von matthias am 11.01.2004 um 20:23
ich denke damit unterdrückt man "." und ".." da die normalerweiße immer vorhanden sind (Ordner zurück ...!?)
Kommentar von Yakazoo am 08.10.2003 um 08:54
Bei der Zeile hab ich ne Frage!
If (File <> ".") And (File <> "..") Then
List1.AddItem "." & File 'Verzeichnis
Dirs = Dirs + 1
End If
Wozu ist das gut? Das ergibt 0 Sinn. Wenn ich das weglasse kommt das gleiche raus
Kommentar von Norman Völtz am 22.03.2002 um 12:35
Bei der Auflistung fehlt die &H30 das sind bei mir Verzeichnisse auf einem NT File Server
Norman