Startseite / Tipps / VB 5/6-Tipp 0064: Verzeichnis und Datei-Attribute per API auslesen

VB 5/6-Tipp 0064: Verzeichnis und Datei-Attribute per API auslesen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Listen-Steuerelement "List1" (Index von 0 bis 6)
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label9"
' Steuerelement: Beschriftungsfeld "Label8"
' Steuerelement: Beschriftungsfeld "Label7"
' Steuerelement: Beschriftungsfeld "Label6"
' Steuerelement: Beschriftungsfeld "Label5"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

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
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Private Sub Form_Load()
//wie im Explorer in der Detailansicht!
  Label1.Caption="Geändert am"
  Label2.Caption="Erstellt am"
  Label3.Caption="Letzter Zugriff"
End Sub

//in Sub AddFile ersetze:
  List1(4).AddItem FormatDate(wFD.ftLastWriteTime)
  List1(5).AddItem FormatDate(wFD.ftCreationTime)
  List1(6).AddItem FormatDate(wFD.ftLastAccessTime)