![]() |
Tipp 0327
|
Rekursives Suchen von Dateien (API)
|
 |
|
Autor/Einsender: Datum: |
|
Angie 20.04.2003 |
|
Entwicklungsumgebung: |
|
VB 5 |
|
|
Um eine Dateisuche zu verwirklichen, benötigt man eine Funktion, die nicht nur das aktuelle Verzeichnis, sondern auch alle Unterverzeichnisse
durchsucht. Dazu kann man sich verschiedener Methoden bedienen, z.B. mittels API-Funktionen, dem FileSystemObject oder auch der Visual Basic
Dir$-Funktion.
|
Dieses Beispiel zeigt, wie man mit Hilfe der API-Funktionen FindFirstFile und FindNextFile eine rekursive Suche
verwirklichen kann, die alle Dateien mit dem übergebenen Suchmuster auflistet. Diese Methode ist bedeutend schneller als eine rekursive
Suche mit der Dir$-Funktion oder dem FileSystemObject (FSO).
|
|
|
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
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 Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
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 * MAX_PATH
cAlternate As String * 14
End Type
Private m_lngDirCount As Long
Private m_lngFileCount As Long
Private m_astrFiles() As String
Private m_blnCancel As Boolean
Private Sub Form_Load()
lblMsg.Caption = ""
lstFiles.Clear
End Sub
Private Sub cmdSuchen_Click()
Dim tStart As Single
Dim tEnd As Single
Dim tDiff As String
Dim i As Long
Dim strMsg As String
lstFiles.Visible = False
lstFiles.Clear
m_blnCancel = False
m_lngDirCount = 1
m_lngFileCount = 0
ReDim m_astrFiles(0 To 100)
tStart = GetTickCount()
FindFiles Dir1.Path, txtSearchString.Text
If m_lngFileCount > 0 Then
lblMsg.Caption = "Bitte warten... " & _
"Die Dateien werden zur ListBox hinzugefügt..."
DoEvents
For i = 0 To m_lngFileCount - 1
lstFiles.AddItem m_astrFiles(i)
Next
End If
tEnd = GetTickCount()
tDiff = Format$((tEnd - tStart) / 1000, "##0.00") & " sec."
strMsg = m_lngFileCount & " Dateien gefunden / " & _
m_lngDirCount & " Ordner durchsucht."
If m_blnCancel Then
lblMsg.Caption = _
"Die Suche nach Datei(en) wurde abgebrochen! " & strMsg
Else
lblMsg.Caption = strMsg & " (Dauer: " & tDiff & ")"
End If
lstFiles.Visible = True
End Sub
Private Sub cmdAbbrechen_Click()
m_blnCancel = True
End Sub
Private Sub FindFiles(ByVal vsFolderPath As String, _
ByVal vsSearch As String)
Dim WFD As WIN32_FIND_DATA
Dim hSearch As Long
Dim strDirName As String
If m_blnCancel = True Then GoTo byebye
lblMsg.Caption = vsFolderPath
DoEvents
If Right$(vsFolderPath, 1) <> "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & "*.*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
GetFilesInFolder vsFolderPath, vsSearch
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = TrimNulls(WFD.cFileName)
If (strDirName <> ".") And (strDirName <> "..") Then
m_lngDirCount = m_lngDirCount + 1
FindFiles vsFolderPath & strDirName, vsSearch
End If
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
End If
byebye:
End Sub
Private Sub GetFilesInFolder(ByVal vsFolderPath As String, _
ByVal vsSearch As String)
Dim WFD As WIN32_FIND_DATA
Dim hSearch As Long
Dim strFileName As String
If Right$(vsFolderPath, 1) <> "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & vsSearch, WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> _
FILE_ATTRIBUTE_DIRECTORY Then
strFileName = TrimNulls(WFD.cFileName)
m_astrFiles(m_lngFileCount) = vsFolderPath & strFileName
m_lngFileCount = m_lngFileCount + 1
If (m_lngFileCount Mod 100) = 0 Then
ReDim Preserve m_astrFiles(m_lngFileCount + 100)
End If
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
End If
End Sub
Private Function TrimNulls(ByVal vsStringIn As String) As String
If InStr(vsStringIn, Chr(0)) > 0 Then
vsStringIn = Left$(vsStringIn, InStr(vsStringIn, Chr(0)) - 1)
End If
TrimNulls = vsStringIn
End Function
|
|
|
|
|
Windows-Version |
95 |
 |
|
98/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (5,5 kB)
|
Downloads bisher: [ 3903 ]
|
|
|