|
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
Const MAX_PATH = 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
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Sub Form_Load()
Dir1_Change
End Sub
Private Sub Dir1_Change()
Dim Dateien() As String, x As Long
Dim Datei As Integer, Ordner As Integer, Groesse As Long
Dim Pfad As String, Alle As String
Screen.MousePointer = vbHourglass
Label1(1).Caption = ""
Label1(3).Caption = ""
Label1(5).Caption = ""
Label1(7).Caption = ""
Label1(8).Caption = "Inhalt von: " & vbCrLf & Dir1.Path
Pfad = Dir1.Path
Alle = "*.*"
ReDim Dateien(0 To 0)
DoEvents
GetAllFiles Pfad, Alle, Dateien
For x = 0 To UBound(Dateien) - 1
If Left$(Dateien(x), 1) = "°" Then
Ordner = Ordner + 1
Else
Groesse = Groesse + FileLen(Trim$(Dateien(x)))
Datei = Datei + 1
End If
Next x
Label1(1).Caption = Format$(Ordner, "###,##0") & " "
Label1(3).Caption = Format$(Datei, "###,##0") & " "
Label1(5).Caption = Format$(Groesse, "###,##0") & " "
Label1(7).Caption = Format$((Groesse / 1024) / 1024, _
"###,##0.00") & " "
Screen.MousePointer = 0
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub GetAllFiles(ByVal Pfad As String, ByVal Patt$, _
ByRef Field() As String)
Dim Datei$, hFile&, FD As WIN32_FIND_DATA
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
hFile = FindFirstFile(Pfad & Patt, FD)
If hFile = 0 Then Exit Sub
Do
Datei = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
= FILE_ATTRIBUTE_DIRECTORY Then
If (Datei <> ".") And (Datei <> "..") Then
Field(UBound(Field)) = "°" & Pfad & Datei
ReDim Preserve Field(0 To UBound(Field) + 1)
GetAllFiles Pfad & Datei, Patt, Field
End If
Else
Field(UBound(Field)) = Pfad & Datei
ReDim Preserve Field(0 To UBound(Field) + 1)
End If
Loop While FindNextFile(hFile, FD)
FindClose hFile
End Sub
|
|