Auslöser für diesen Tipp, war das unternehmensweite
Update einer Software.
Da nicht alle Stationen über diese Software verfügen und da es unterschiedliche
Versionen der Software in unterschiedlichen Verzeichnissen gab, war es notwendig, auf
einem bestimmten Laufwerk, ab einer bestimmten Verzeichnistiefe zu ermitteln, ob eine
Datei vorhanden war, damit das Update erfolgen konnte.
Nun fangen wir nicht mir DIR /S an, sondern möchten eine saubere VB Lösung, aber das ist
nicht so ganz profan. Denn hier geht es um rekursive Prozeduren,
die sich selbst aufrufen.
Auch ich erfinde das Rad nicht neu, wenn es schon etwas gutes gibt und so stammt der Teil
des Projektes, das die eigentliche Arbeit übernimmt, auch nicht von mir.
Und los gehts.
- Fügen Sie Ihrem Projekt ein Modul hinzu und kopieren Sie
nachfolgenden SourceCode hinein
Allgemein/Deklarationen
Option Explicit
Public Declare Function FindFirstFile& Lib "kernel32" Alias
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA)
Public Declare Function FindNextFile& Lib "kernel32" Alias
"FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA)
Public Declare Function FindClose& Lib "kernel32" (ByVal hFindFile As Long)
Public Const MAX_PATH& = 260
Public Const FILE_ATTRIBUTE_DIRECTORY& = &H10
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
Allgemein/StripNull
Public Function StripNull(Usestr As String) As String
Dim position As Integer
position = InStr(Usestr, Chr$(0))
If position <= 1 Then
StripNull = ""
Exit Function
End If
StripNull = Left$(Usestr, position - 1)
End Function
Allgemein/SearchExactFile 'das Kennstück des Projekts
Public Sub SearchExactFile(Path As String, FileToFind As String, LstBox As ListBox)
Dim mywin As WIN32_FIND_DATA
Dim searchhandle As Long
Dim testfilestring As String
Dim morefiles As Boolean
morefiles = True
If Right(Path, 1) <> "\" Then Path = Path & "\"
searchhandle = FindFirstFile(Path & "*.*", mywin)
If mywin.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY Then
testfilestring = mywin.cFileName
testfilestring = StripNull(testfilestring)
If UCase(testfilestring) = UCase(FileToFind) Then LstBox.AddItem Path &
testfilestring
Else
testfilestring = StripNull(mywin.cFileName)
If testfilestring <> "." And testfilestring <>
".." Then
Call SearchExactFile(Path & testfilestring, FileToFind,
LstBox)
End If
End If
Do While morefiles = True
morefiles = FindNextFile(searchhandle, mywin)
If morefiles = True Then
If mywin.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY
Then
testfilestring = mywin.cFileName
testfilestring =
StripNull(testfilestring)
If UCase(testfilestring) =
UCase(FileToFind) Then LstBox.AddItem Path & testfilestring
Else
testfilestring = mywin.cFileName
testfilestring =
StripNull(testfilestring)
If testfilestring <> "."
And testfilestring <> ".." Then Call SearchExactFile(Path &
testfilestring, FileToFind, LstBox)
End If
Else
Call FindClose(searchhandle)
Exit Sub
End If
Loop
End Sub
- Allgemein/Deklarationen der Form
Dim extension As String
- Fügen Sie Ihrer Form einen Commandbutton (Command1) und
eine Listbox hinzu. Der Commandbutton soll die Suche auslösen und die Listbox dient hier
zur Ergebnisanzeige.
Der Funktionsaufruf / Command1_Click
Dim searchpath As String
List1.Clear
DoEvents
searchpath = "C:\Windows\" 'ab dieser Verzeichnistiefe wird
gescannt
Screen.MousePointer = 11
Call SearchExactFile(searchpath, "notepad.exe", List1)
Screen.MousePointer = 0
- Starten sie Ihr Projekt mit F5 und suchen Sie die Datei.
Ggf. müssen sie die Pfade anpassen.
In meinem Programm habe ich dann noch die Ausgabe in die Listbox gegen das Setzen einer
booleschen Variable auf True ausgetauscht und konnte so feststellen, ob das gesuchte
Programm auf der Station vorhanden war.
|
