Datum vytv., modif. a posl. přístupu k souboru

Postup:
Option Explicit

Private Type FILETIME
   LowDateTime As Long
   HighDateTime As Long
End Type

Private Type SYSTEMTIME
   Year As Integer
   Month As Integer
   DayOfWeek As Integer
   Day As Integer
   Hour As Integer
   Minute As Integer
   Second As Integer
   Milliseconds As Integer
End Type

Private Declare Function CreateFile Lib "kernel32" Alias _
   "CreateFileA" (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   ByVal lpSecurityAttributes As Long, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileTime Lib "kernel32" _
   (ByVal hFile As Long, lpCreationTime As Any, _
   lpLastAccessTime As Any, lpLastWriteTime As Any) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" _
   (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
   (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long

Function FileSetDate(ByVal sFileName As String, _
   ByVal dFileDate As Date, _
   Optional bSetCreationTime As Boolean = False, _
   Optional bSetLastAccessedTime As Boolean = False, _
   Optional bSetLastWriteTime As Boolean = False) As Boolean

   Const GENERIC_WRITE = &H40000000, OPEN_EXISTING = 3
   Const FILE_SHARE_READ = &H1, FILE_SHARE_WRITE = &H2

   Dim lhwndFile As Long
   Dim tSystemTime As SYSTEMTIME
   Dim tLocalTime As FILETIME, tFileTime As FILETIME

   tSystemTime.Year = Year(dFileDate)
   tSystemTime.Month = Month(dFileDate)
   tSystemTime.Day = Day(dFileDate)
   tSystemTime.DayOfWeek = Weekday(dFileDate) - 1
   tSystemTime.Hour = Hour(dFileDate)
   tSystemTime.Second = Second(dFileDate)
   tSystemTime.Milliseconds = 0

   lhwndFile = CreateFile(sFileName, GENERIC_WRITE, _
      FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, _
      OPEN_EXISTING, 0, 0)

   If lhwndFile Then
     SystemTimeToFileTime tSystemTime, tLocalTime
     LocalFileTimeToFileTime tLocalTime, tFileTime
     FileSetDate = True
     If bSetCreationTime Then
        FileSetDate = FileSetDate And _
          CBool(SetFileTime(lhwndFile, tFileTime, 0&, 0&))
     End If
     If bSetLastAccessedTime Then
       FileSetDate = FileSetDate And _
         CBool(SetFileTime(lhwndFile, 0&, tFileTime, 0&))
     End If
     If bSetLastWriteTime Then
       FileSetDate = FileSetDate And _
        CBool(SetFileTime(lhwndFile, 0&, 0&, tFileTime))
     End If
     Call CloseHandle(lhwndFile)
   End If

End Function

Přiklad použití:
Sub Test()

   'Nastavení datumu a času vytvoření
   FileSetDate "C:\Posters.html", Now, True
   'Nastavení datumu a času posledního přístupu
   FileSetDate "C:\Posters.html", Now, , True
   'Nastavení datumu a času poslední modifikace
   FileSetDate "C:\Posters.html", Now, , , True

End Sub

Zpět