 |
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 Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) _
As Long
Const MAX_PATH = 260
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
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 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 Sub Command1_Click()
Dim Result&, hFind&
Dim wFD As WIN32_FIND_DATA
For Result = 0 To List1.UBound
List1(Result).Clear
Next Result
hFind = FindFirstFile(Text2.Text & Text1.Text, wFD)
Call AddFile(wFD)
Do
Result = FindNextFile(hFind, wFD)
If Result > 0 Then Call AddFile(wFD)
Loop While Result > 0
Result = FindClose(hFind)
End Sub
Private Sub AddFile(wFD As WIN32_FIND_DATA)
Dim size&
List1(0).AddItem wFD.cFileName
List1(1).AddItem wFD.cAlternate
size = wFD.nFileSizeLow / 1024
List1(2).AddItem size & " kB"
List1(3).AddItem FormatAttr(wFD.dwFileAttributes)
List1(4).AddItem FormatDate(wFD.ftCreationTime)
List1(5).AddItem FormatDate(wFD.ftLastAccessTime)
List1(6).AddItem FormatDate(wFD.ftLastWriteTime)
End Sub
Private Function FormatDate(Data As FILETIME) As String
Dim Result&, FTime As SYSTEMTIME
Dim T$, M$, J$, ST$, MI$, SE
Result = FileTimeToSystemTime(Data, FTime)
T = FTime.wDay
M = FTime.wMonth
J = FTime.wYear & " "
If Len(T) = 1 Then T = "0" & T
If Len(M) = 1 Then M = "0" & M
ST = FTime.wHour
MI = FTime.wMinute
SE = FTime.wSecond
If Len(ST) = 1 Then ST = "0" & ST
If Len(MI) = 1 Then MI = "0" & MI
If Len(SE) = 1 Then SE = "0" & SE
FormatDate = T & "." & M & "." & J & ST & ":" & MI & ":" & SE
End Function
Private Function FormatAttr(Attr&) As String
Dim AA$
If Attr And FILE_ATTRIBUTE_ARCHIVE Then AA = AA & "A"
If Attr And FILE_ATTRIBUTE_COMPRESSED Then AA = AA & "C"
If Attr And FILE_ATTRIBUTE_DIRECTORY Then AA = AA & "D"
If Attr And FILE_ATTRIBUTE_HIDDEN Then AA = AA & "H"
If Attr And FILE_ATTRIBUTE_NORMAL Then AA = AA & "N"
If Attr And FILE_ATTRIBUTE_READONLY Then AA = AA & "R"
If Attr And FILE_ATTRIBUTE_SYSTEM Then AA = AA & "S"
FormatAttr = AA
End Function
Private Sub List1_Click(Index As Integer)
Dim x%
Static Making As Boolean
If Making Then Exit Sub
Making = True
For x = 0 To List1.UBound
If x <> Index Then
List1(x).ListIndex = List1(Index).ListIndex
List1(x).TopIndex = List1(Index).TopIndex
End If
Next x
Making = False
End Sub
|
