Dateiattribute

MS-Dos Name, Attribut, Größe, Erstellungszeitpunkt, Letzter Zugriff und Letzte Änderung lassen sich auslesen. Ohne Filesystemobject FSO!

Beispieldatei (Fileinfos.zip 29 kB)

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
  (ByVal lpFileName As String, 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

Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

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 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 Sub FileInfo(Pfad As String, Optional Erstellungszeitpunkt As Date, _
  Optional LetzterZugriff As Date, Optional LetzteÄnderung As Date, _
  Optional Dateiattribute$, Optional Dateigröße&, Optional MsDosName$, _
  Optional NormalerName$)
Dim Dateiinformation As WIN32_FIND_DATA
Dim Systemzeit As SYSTEMTIME
Dim Dateizeit As FILETIME
Dim Filehandle&, dummy
  Filehandle = FindFirstFile(Pfad, Dateiinformation)
  dummy = FileTimeToSystemTime(Dateiinformation.ftCreationTime, Systemzeit)
  Erstellungszeitpunkt = DateSerial(Systemzeit.wYear, Systemzeit.wMonth, _
    Systemzeit.wDay) + TimeSerial(Systemzeit.wHour, Systemzeit.wMinute, Systemzeit.wSecond)
  dummy = FileTimeToSystemTime(Dateiinformation.ftLastAccessTime, Systemzeit)
  LetzterZugriff = DateSerial(Systemzeit.wYear, Systemzeit.wMonth, _
    Systemzeit.wDay) + TimeSerial(Systemzeit.wHour, Systemzeit.wMinute, Systemzeit.wSecond)
  dummy = FileTimeToSystemTime(Dateiinformation.ftLastWriteTime, Systemzeit)
  LetzteÄnderung = DateSerial(Systemzeit.wYear, Systemzeit.wMonth, _
    Systemzeit.wDay) + TimeSerial(Systemzeit.wHour, Systemzeit.wMinute, Systemzeit.wSecond)
  Select Case Dateiinformation.dwFileAttributes
    Case FILE_ATTRIBUTE_ARCHIVE
      Dateiattribute = "Archiv"
    Case FILE_ATTRIBUTE_COMPRESSED
      Dateiattribute = "Komprimiert"
    Case FILE_ATTRIBUTE_NORMAL
      Dateiattribute = "Normal"
    Case FILE_ATTRIBUTE_DIRECTORY
      Dateiattribute = "Verzeichnis"
    Case FILE_ATTRIBUTE_READONLY
      Dateiattribute = "Schreibschutz"
    Case FILE_ATTRIBUTE_SYSTEM
      Dateiattribute = "Systemdatei"
    Case FILE_ATTRIBUTE_TEMPORARY
      Dateiattribute = "Temporär"
    Case Else
      Dateiattribute = "Unbekannt"
  End Select
  Dateigröße = Dateiinformation.nFileSizeLow
  MsDosName = Trim(Dateiinformation.cFileName)
  NormalerName = Dateiinformation.cFileName
  dummy = FindClose(Filehandle)
End Sub

Public Function Erstellungszeitpunkt(ByVal Pfad As String) As Date
Dim dummy As Date
  Call FileInfo(Pfad, dummy)
  Erstellungszeitpunkt = dummy
End Function

Public Function LetzterZugriff(ByVal Pfad As String) As Date
Dim dummy As Date
  Call FileInfo(Pfad, , dummy)
  LetzterZugriff = dummy
End Function

Public Function LetzteÄnderung(ByVal Pfad As String) As Date
Dim dummy As Date
  Call FileInfo(Pfad, , , dummy)
  LetzteÄnderung = dummy
End Function

Public Function Dateigröße(ByVal Pfad As String) As Long
Dim dummy&
  Call FileInfo(Pfad, , , , , dummy)
  Dateigröße = dummy
End Function

Public Function Dateiattribut(ByVal Pfad As String) As String
Dim dummy$
  Call FileInfo(Pfad, , , , dummy)
  Dateiattribut = dummy
End Function

Public Function MsDosName(ByVal Pfad As String) As String
Dim dummy$
  Call FileInfo(Pfad, , , , , , dummy)
  MsDosName = dummy
End Function

Public Function NormalerName(ByVal Pfad As String) As String
Dim dummy$
  Call FileInfo(Pfad, , , , , , , dummy)
  NormalerName = dummy
End Function