Hallo Arnold,
ich habe mir den Tipp0128 von AVB einmal vorgenommen und einiges von der eingebauten Flexibilität entfernt. Auf der Form liegt jetzt nur noch ein Button und eine Listbox.
Option Explicit
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 Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
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 Declare Function GetFileTime Lib "kernel32" (ByVal \_
hFile As Long, lpCreationTime As FILETIME, \_
lpLastAccessTime As FILETIME, lpLastWriteTime \_
As FILETIME) As Long
Const MAX\_PATH As Long = 259&
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 Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" \_
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, \_
ByVal dwShareMode As Long, lpSecurityAttributes As Long, \_
ByVal dwCreationDisposition As Long, ByVal \_
dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" \_
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" \_
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Const GENERIC\_WRITE = &H40000000
Private Const OPEN\_EXISTING = 3
Private Const FILE\_SHARE\_READ = &H1
Private Const FILE\_SHARE\_WRITE = &H2
Private Const FO\_DELETE = &H3
Const FILE\_ATTRIBUTE\_ARCHIVE As Long = &H20&
Const FILE\_ATTRIBUTE\_COMPRESSED As Long = &H800&
Const FILE\_ATTRIBUTE\_DIRECTORY As Long = &H10&
Const FILE\_ATTRIBUTE\_HIDDEN As Long = &H2&
Const FILE\_ATTRIBUTE\_NORMAL As Long = &H80&
Const FILE\_ATTRIBUTE\_READONLY As Long = &H1&
Const FILE\_ATTRIBUTE\_SYSTEM As Long = &H4&
Const FILE\_ATTRIBUTE\_TEMPORARY As Long = &H100&
Private Sub Command1\_Click()
Dim Files() As String
Dim X As Long
Dim Such As String
Dim DatCnt As Integer, DirCnt As Integer
Dim Max As Long
Such = "\*"
ReDim Files(0 To 0)
MousePointer = 11
DoEvents
Max = GetAllFiles("C:\Programme\Microsoft Visual Studio\VB98", Such, Files)
MousePointer = 0
DoEvents
List1.Clear
List1.Visible = False
For X = 0 To Max - 1
List1.AddItem Files(X)
If Left$(Files(X), 2) = "\>\>" Then
DirCnt = DirCnt + 1
Else
DatCnt = DatCnt + 1
End If
Next X
List1.Visible = True
End Sub
Private Function GetAllFiles(ByVal Root As String, \_
ByVal Such As String, ByRef Field() As String, \_
Optional UsedField As Long = 0) As Long
Dim File As String
Dim hFile As Long
Dim FD As WIN32\_FIND\_DATA
Dim lngHandle As Long, SHDirOp As SHFILEOPSTRUCT, lngLong As Long
Dim Ft1 As FILETIME, Ft2 As FILETIME, SysTime As SYSTEMTIME
If (UsedField = UBound(Field)) Then
ReDim Preserve Field(UBound(Field) + 100)
End If
DoEvents
If Right(Root, 1) "\" Then Root = Root & "\"
hFile = FindFirstFile(Root & "\*.\*", FD)
If hFile = 0 Then
GetAllFiles = 0
Exit Function
End If
Do
File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
If (FD.dwFileAttributes And FILE\_ATTRIBUTE\_DIRECTORY) \_
= FILE\_ATTRIBUTE\_DIRECTORY Then
If (File ".") And (File "..") Then
GetAllFiles = GetAllFiles + GetAllFiles(Root & File, \_
Such, Field, UsedField)
Else
Field(UsedField) = "\>\>" & Root & File
GetAllFiles = GetAllFiles + 1
UsedField = UsedField + 1
If (UsedField = UBound(Field)) = 0 Then
ReDim Preserve Field(0 To UBound(Field) + 100)
End If
End If
End If
If (Such Like Right$(UCase$(File), Len(Such))) Or Such = "\*" Then
lngHandle = CreateFile(Root & File, GENERIC\_WRITE, FILE\_SHARE\_READ Or \_
FILE\_SHARE\_WRITE, ByVal 0&, OPEN\_EXISTING, 0, 0)
GetFileTime lngHandle, Ft1, Ft1, Ft2
FileTimeToLocalFileTime Ft2, Ft1
FileTimeToSystemTime Ft1, SysTime
Field(UsedField) = " " & Root & File + Str$(SysTime.wMonth) \_
+ "/" + LTrim(Str$(SysTime.wDay)) + "/" + LTrim(Str$(SysTime.wYear))
GetAllFiles = GetAllFiles + 1
UsedField = UsedField + 1
If (UsedField = UBound(Field)) Then
ReDim Preserve Field(0 To UBound(Field) + 100)
End If
End If
Loop While FindNextFile(hFile, FD)
Call FindClose(hFile)
End Function
Das sieht nach schrecklich viel Code aus, aber das kann man ja in ein Modul packen. Obwohl es so umständlich aussieht, ist es doch sehr viel schneller als FSO. Ich nehme an, daß man da noch etwas optimieren kann, ich bekomme das aber auf die Schnelle nicht hin. 
Gruß, Rainer
