Wie kann ich mit VB Datenträger schnell nach Dateien durchsuchen

Computer: Software & Programmierung Visual Basic
#1

Hallo,

Lege diese Suche dazu in eine Klasse und schon ist sie flexibel. Brauchst du sie nochmal, so binde dann einfach die geschriebene Klasse in dein neues Project ein und volla, fertig.

Wie so etwas ausschauen kann, schau :wink:

'Klasse cFindFile

Option Explicit

' Benötigte API´s
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 FileTimeToSystemTime Lib "kernel32" \_
 (lpFileTime As FILETIME, \_
 lpSystemTime As SYSTEMTIME) As Long


' Benutzerdefinierte Konstanten
Private Const MAX\_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID\_HANDLE\_VALUE = -1
Private Const MyUnhandledError = 9999


' Benutzerdefinierte Typen
Private Type FILETIME
 dwLowDateTime As Long
 dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
 wYear As Integer
 wMonth As Integer
 wDayOfWeek As Integer
 wDay As Integer
 wHour As Integer
 wMinute As Integer
 wSecond As Integer
 wMilliseconds As Integer
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


' Aufzählung für sFileFlag Eigenschaft
Public Enum FileFlag
 FILE\_ATTRIBUTE\_READONLY = &H1
 FILE\_ATTRIBUTE\_HIDDEN = &H2
 FILE\_ATTRIBUTE\_SYSTEM = &H4
 FILE\_ATTRIBUTE\_DIRECTORY = &H10
 FILE\_ATTRIBUTE\_ARCHIVE = &H20
 FILE\_ATTRIBUTE\_NORMAL = &H80
 FILE\_ATTRIBUTE\_TEMPORARY = &H100
 FILE\_ATTRIBUTE\_ALLTYPES = &H1B7
 FILE\_ATTRIBUTE\_ALLTYPES\_WITHOUT\_DIR = &H1A7
End Enum


'lokale Variablen zum Zuweisen der Eigenschaften
Private mvarsSearchpath As String
Private mvarsFileToFind As String
Private mvarsInclSubfolders As Boolean
Private mvarsFileFlag As FileFlag


'RaiseEvent MatchFound[(arg1, arg2, ... , argn)]
Public Event MatchFound(ByVal sFilename As String, \_
 ByVal sFilePath As String, \_
 ByVal sFiledate As Date, \_
 ByVal sFilesize As Long, \_
 ByVal sLastAccess As Date, \_
 ByVal sLastWrite As Date, \_
 ByVal sShortName As String)

'RaiseEvent StopSearch[(arg1)]
Public Event StopSearch(Cancel As Boolean)

Private Sub Class\_Initialize()
 'Die Klasse wird initialisiert.
 sFileFlag = FILE\_ATTRIBUTE\_ALLTYPES
 sInclSubfolders = True
End Sub

Private Sub Class\_Terminate()
 'Die Klasse wird aus dem Speicher entfernt.
End Sub

Public Sub sStartSearch()
 Dim lFileToFind As String, lSearchpath As String, FileName As String
 Dim ShortName As String, DirName As String, DirNames() As String
 Dim DirCount As Integer, nDir As Integer, Cont As Integer, I As Integer
 Dim Filesize As Long, hSearch As Long
 Dim Filedate As Date, LastAccess As Date, LastWrite As Date
 Dim lInclSubfolders As Boolean, bCancel As Boolean
 Dim sDate As SYSTEMTIME
 Dim lFileFlag As FileFlag
 Dim WFD As WIN32\_FIND\_DATA

 On Error GoTo sStartSearchErr

 ' Eigenschaften Property Get in lokale Variablen kopieren
 lFileToFind = sFileToFind
 lFileFlag = sFileFlag
 lSearchpath = sSearchpath
 lInclSubfolders = sInclSubfolders

 ' Initialisieren der Variablen
 If Right(lSearchpath, 1) "\" Then lSearchpath = lSearchpath & "\"
 nDir = 0
 DirCount = 0
 ReDim DirNames(nDir)
 Cont = True
 bCancel = False

 ' Die Suche geht los. Zuerst werden die Subfolders ermittelt
 hSearch = FindFirstFile(lSearchpath & "\*", WFD)
 If hSearch INVALID\_HANDLE\_VALUE Then
 Do While Cont
 ' vbNullChar entfernen
 DirName = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

 ' Prüfen, ob DirName auch wirklich ein Subfolder ist
 If (DirName ".") And (DirName "..") Then
 If (WFD.dwFileAttributes And vbDirectory) = FileFlag.FILE\_ATTRIBUTE\_DIRECTORY Then

 ' Subfolder ins loakale Array speichern
 DirNames(nDir) = DirName

 ' Schleifenzähler erhöhen
 DirCount = DirCount + 1
 nDir = nDir + 1

 ' Lokales Array neu dimensionieren
 ReDim Preserve DirNames(nDir)
 End If
 End If

 ' Nächster Subfolder ermitteln
 Cont = FindNextFile(hSearch, WFD)

 ' Geben wir der Methode ein wenig Zeit zum Atmen
 DoEvents
 Loop
 Cont = FindClose(hSearch)
 End If

 ' Jetzt werden die zu findenden Dateien ermittelt
 hSearch = FindFirstFile(lSearchpath & lFileToFind, WFD)
 Cont = True
 If hSearch INVALID\_HANDLE\_VALUE Then
 While Cont
 ' vbNullChar entfernen
 FileName = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

 ' Prüfen, ob FileName ungleich . und .. ist
 If (FileName ".") And (FileName "..") Then
 ' Stimmt das FileAttribut mit Eigenschaft sFileFlag überein
 If (WFD.dwFileAttributes Or lFileFlag) = lFileFlag Then

 ' Dateigröße ermitteln
 Filesize = (WFD.nFileSizeHigh \* MAXDWORD) + WFD.nFileSizeLow

 ' Dateidatum/Zeit ermitteln
 FileTimeToSystemTime WFD.ftCreationTime, sDate
 With sDate
 Filedate = CDate(.wDay & "." & .wMonth & "." & .wYear \_
 & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
 End With

 ' LastAccess ermitteln
 FileTimeToSystemTime WFD.ftLastAccessTime, sDate
 With sDate
 LastAccess = CDate(.wDay & "." & .wMonth & "." & .wYear \_
 & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
 End With

 ' LastWrite ermitteln
 FileTimeToSystemTime WFD.ftLastWriteTime, sDate
 With sDate
 LastWrite = CDate(.wDay & "." & .wMonth & "." & .wYear \_
 & " " & .wHour & ":" & .wMinute & ":" & .wSecond)
 End With

 ' ShortName 8.3 ermitteln
 ShortName = Left$(WFD.cAlternate, InStr(WFD.cAlternate, vbNullChar) - 1)

 ' Und jetzt den Event aufrufen um die Dateiinformationen zu übergeben
 RaiseEvent MatchFound(FileName, lSearchpath, Filedate, Filesize, \_
 LastAccess, LastWrite, ShortName)
 End If
 End If

 ' Nächste Datei ermitteln
 Cont = FindNextFile(hSearch, WFD)

 ' Geben wir der Methode ein wenig Zeit zum Atmen
 DoEvents
 Wend
 ' Suche abgeschlossen
 Cont = FindClose(hSearch)
 End If

 ' Sollen die Subfolders durchsucht werden?
 If lInclSubfolders Then
 ' Prüfen, ob im aktuellen Folder weitere Subfolder sind
 If nDir \> 0 Then
 ' Rekursiver Aufruf der Methode mit Übergabe eines neuen Subfolders
 For I = 0 To nDir - 1
 ' Event StopSearch aufrufen und prüfen ob Abbruch
 ' durch Benutzer erfolgte
 RaiseEvent StopSearch(bCancel)
 If bCancel Then Exit Sub

 ' neuer Suchpfad an Property Let sSearchpath übergeben
 sSearchpath = lSearchpath & DirNames(I)
 ' neue Suche starten...
 sStartSearch
 Next I
 End If
 End If
Exit Sub

sStartSearchErr:
 RaiseError MyUnhandledError, "cFindFile:sStartSearch Method" \_
 , "Fehler bei sStartSearch"
End Sub

' Eigenschaft cFindFile.sFileFlag setzen
Public Property Let sFileFlag(ByVal vData As FileFlag)
 On Error GoTo sFileFlagLetErr
 mvarsFileFlag = vData
Exit Property

sFileFlagLetErr:
 RaiseError MyUnhandledError, "cFindFile:sFileFlag Property Let" \_
 , "Fehler bei sFileFlag Property Let"
End Property

' Eigenschaft cFindFile.sFileFlag lesen
Public Property Get sFileFlag() As FileFlag
 On Error GoTo sFileFlagGetErr
 sFileFlag = mvarsFileFlag
Exit Property

sFileFlagGetErr:
 RaiseError MyUnhandledError, "cFindFile:sFileFlag Property Get" \_
 , "Fehler bei sFileFlag Property Get"
End Property

' Eigenschaft cFindFile.sInclSubFolders setzen
Public Property Let sInclSubfolders(ByVal vData As Boolean)
 On Error GoTo sInclSubfoldersLetErr
 mvarsInclSubfolders = vData
Exit Property

sInclSubfoldersLetErr:
 RaiseError MyUnhandledError, "cFindFile:sInclSubfolders Property Let" \_
 , "Fehler bei sInclSubfolders Property Let"
End Property

' Eigenschaft cFindFile.sInclSubFolders lesen
Public Property Get sInclSubfolders() As Boolean
 On Error GoTo sInclSubfoldersGetErr
 sInclSubfolders = mvarsInclSubfolders
Exit Property

sInclSubfoldersGetErr:
 RaiseError MyUnhandledError, "cFindFile:sInclSubfolders Property Get" \_
 , "Fehler bei sInclSubfolders Property Get"
End Property

' Eigenschaft cFindFile.sFileToFind setzen
Public Property Let sFileToFind(ByVal vData As String)
 On Error GoTo sFileToFindLetErr
 mvarsFileToFind = vData
Exit Property

sFileToFindLetErr:
 RaiseError MyUnhandledError, "cFindFile:sFileToFind Property Let" \_
 , "Fehler bei sFileToFind Property Let"
End Property

' Eigenschaft cFindFile.sFileToFind lesen
Public Property Get sFileToFind() As String
 On Error GoTo sFileToFindGetErr
 sFileToFind = mvarsFileToFind
Exit Property

sFileToFindGetErr:
 RaiseError MyUnhandledError, "cFindFile:sFileToFind Property Get" \_
 , "Fehler bei sFileToFind Property Get"
End Property

' Eigenschaft cFindFile.sSearchpath setzen
Public Property Let sSearchpath(ByVal vData As String)
 On Error GoTo sSearchpathLetErr
 mvarsSearchpath = vData
Exit Property

sSearchpathLetErr:
 RaiseError MyUnhandledError, "cFindFile:sSearchpath Property Let" \_
 , "Fehler bei sSearchpath Property Let"
End Property

' Eigenschaft cFindFile.sSearchpath lesen
Public Property Get sSearchpath() As String
 On Error GoTo sSearchpathGetErr
 sSearchpath = mvarsSearchpath
Exit Property

sSearchpathGetErr:
 RaiseError MyUnhandledError, "cFindFile:sSearchpath Property Get" \_
 , "Fehler bei sSearchpath Property Get"
End Property

' Error Object setzen und an den Client übergeben
Private Sub RaiseError(ErrorNumber As Long, Source As String, strErrorText As String)
 Err.Raise ErrorNumber, Source, strErrorText
End Sub

Um die Klasse zu verwenden, brauchst du nur noch wenige Zeilen Source. Da die Suche nun in einer Klasse ausgelagert ist, ist es ja ein Object und hat somit Eigenschaften und kann Ereignisse auslösen, welche dies auch macht :wink:

Also wie gesagt, aufrufen oder starten tust du die Suche via

Option Explicit

'Auf der Form liegen drei Steuerelemente:
'Command1
'Command2
'List1
 
' Klasse mit Ereignissen!
Private WithEvents nSearch As cFindFile
 
' Für Abbruch-Button
Private bCancel As Boolean

Private Sub Form\_Load()
 ' Klasse instanzieren
 Set nSearch = New cFindFile
 Command1.Caption = "Suchen"
 Command2.Caption = "Abbrechen"
End Sub

' Suchvorgang starten
Private Sub Command1\_Click()
 List1.Clear ' Listbox loschen
 bCancel = False ' Abbruchbedingung setzen
 
 With nSearch
 .sSearchpath = "C:\" ' Suchpfad
 .sFileToFind = "\*.ini" ' Suchnamen
 .sFileFlag = FILE\_ATTRIBUTE\_ALLTYPES ' Dateiattribute
 .sInclSubfolders = True ' Subdirs durchsuchen
 
 ' Suche starten
 Screen.MousePointer = 13
 .sStartSearch
 Screen.MousePointer = 0
 End With
End Sub

' Suchvorgang abbrechen!
Private Sub Command2\_Click() 
 
 bCancel = True ' Abbruchbedingung setzen!
End Sub

'Ereignis stellt uns die Klasse bereit :wink:
Private Sub nSearch\_MatchFound(ByVal sFilename As String, \_
 ByVal sFilePath As String, \_
 ByVal sFiledate As Date, \_
 ByVal sFilesize As Long, \_
 ByVal sLastAccess As Date, \_
 ByVal sLastWrite As Date, \_
 ByVal sShortName As String)
 
 ' Listbox mit dem letzten Suchergebnis füllen
 List1.AddItem sFilePath & sFilename
 DoEvents
End Sub

'Auch das Ereignis stellt uns die Klasse zur Verfügung :smile:
Private Sub nSearch\_StopSearch(Cancel As Boolean)
 ' Wurde Stop gedrückt, dann Cancel für den 
 ' Suchabbruch setzen
 If bCancel Then Cancel = bCancel
 DoEvents
End Sub

Schaut vorerst nach viel Arbeit aus, ist es aber nicht und wie du siehst, ist sie nicht nur schnell, sondern auch arg felxibel :smile:
Auch kannst du hier schon deine Ergebnisse verarbeiten, obwohl die Suche nicht beendet ist. Auch kannst du diese vorzeitig abbrechen etc. :smile:

MfG Alex

[Steuerelementeliste als Kommentar eingefügt]

Danke Alex!

Datei speichern in neues Verzeichnis
Datei speichern in neues Verzeichnis
Fenster soll weg!
Fenster soll weg!
UBound --> compile error expected: identifier
UBound --> compile error expected: identifier
UBound --> compile error expected: identifier
Leerlaufzeiten des Prozessors ausnutzen
Leerlaufzeiten des Prozessors ausnutzen
Leerlaufzeiten des Prozessors ausnutzen