Filer - "created date", "modified date" og "accessed date"

Ooops, jeg kom sørenme til at skrive et modul til det.
Det er lavet så man bruger VB datoer til det (så er det til at måle på).
Da Win32 fildatoer er i nanosekunder (jo du læste rigtigt), og vb datoer "kun" arbejder med sekunder, kan der være unøjaktigheder på op til 1 sekund i forbindelse med konvertering fra fildato til VB dato.

Option Explicit

'*** API Declerations ***
'Note: Some of these declaratons has been changed compared to
'those supplied by the API Viewer.
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const GENERIC_WRITE = &H40000000
Private Const hINVALID = -1
Private Const MAX_PATH = 260
Private Const OPEN_EXISTING = 3

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As Currency
  ftLastAccessTime As Currency
  ftLastWriteTime As Currency
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Any) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Currency, lpLocalFileTime As Currency) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As Currency, lpFileTime As Currency) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As Currency, lpLastAccessTime As Currency, lpLastWriteTime As Currency) As Long

'*** FileDateTime enum ***
Public Enum FileDateTimeEnum
  fdtCreated = 1
  fdtUpdated = 2
  fdtAccessed = 3
End Enum

' Difference between day zero for VB dates and Win32 dates' (or #12-30-1899# - #01-01-1601#)
Const rDayZeroBias As Double = 109205# ' Abs(CDbl(#01-01-1601#))

' 10000000 nanoseconds * 60 seconds * 60 minutes * 24 hours / 10000
' comes to 86400000 (the 10000 adjusts for fixed point in Currency)
Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#

Private Function Win32ToVbTime(ft As Currency) As Date
  Dim ftl As Currency
 
  '*** Call API to convert from UTC time to local time ***
  If FileTimeToLocalFileTime(ft, ftl) Then
    ' Local time is nanoseconds since 01-01-1601
    ' In Currency that comes out as milliseconds
    ' Divide by milliseconds per day to get days since 1601
    ' Subtract days from 1601 to 1899 to get VB Date equivalent
    Win32ToVbTime = CDate((ftl / rMillisecondPerDay) - rDayZeroBias)
  Else
    Err.Raise Err.LastDllError
  End If
End Function

Private Function VbToWin32Time(FileTime As Date) As Currency
  Dim ft As Currency
  Dim ftl As Currency
 
  ftl = (CDbl(FileTime) + rDayZeroBias) * rMillisecondPerDay
   
  '*** Call API to convert from Local time to UTC time ***
  If LocalFileTimeToFileTime(ftl, ft) Then
    VbToWin32Time = ft
  Else
    Err.Raise Err.LastDllError
  End If
End Function

Public Function GetFileDateTime(FilePath As String, DateType As FileDateTimeEnum) As Date
  Dim fnd As WIN32_FIND_DATA
  Dim hFind As Long
 
  '*** Get all three times in UDT ***
  hFind = FindFirstFile(FilePath, fnd)
  If hFind = hINVALID Then Err.Raise Err.LastDllError
  FindClose hFind
 
  '*** Convert the selcted date field to VB format and return it. ***
  Select Case DateType
    Case fdtCreated
      GetFileDateTime = Win32ToVbTime(fnd.ftCreationTime)
    Case fdtUpdated
      GetFileDateTime = Win32ToVbTime(fnd.ftLastWriteTime)
    Case fdtAccessed
      GetFileDateTime = Win32ToVbTime(fnd.ftLastAccessTime)
  End Select
End Function

Public Sub SetFileDateTime(FilePath As String, FileTime As Date, DateType As FileDateTimeEnum)
  Dim fnd As WIN32_FIND_DATA
  Dim hHandle As Long
 
  '*** Get all three times in UDT ***
  hHandle = FindFirstFile(FilePath, fnd)
  If hHandle = hINVALID Then Err.Raise Err.LastDllError
  FindClose hHandle
 
  '*** Insert converted date into selected date field. ***
  Select Case DateType
    Case fdtCreated
      fnd.ftCreationTime = VbToWin32Time(FileTime)
    Case fdtUpdated
      fnd.ftLastWriteTime = VbToWin32Time(FileTime)
    Case fdtAccessed
      fnd.ftLastAccessTime = VbToWin32Time(FileTime)
  End Select
 
  '*** Open handle to file to set date field through ***
  hHandle = CreateFile(FilePath, GENERIC_WRITE, 0, 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
  If hHandle = hINVALID Then Err.Raise Err.LastDllError

  '*** Set date fields ***
  If SetFileTime(hHandle, fnd.ftCreationTime, fnd.ftLastAccessTime, fnd.ftLastWriteTime) = 0 Then
    Err.Raise Err.LastDllError
  End If
 
  CloseHandle hHandle
End Sub

Så skulle mine 60 point vist være mere end fortjent, ikke ;)

Philip

Tja, hvorfor gøre det så besværligt når VB er så sød at stille Referencen til FileSystemObject til rådighed ... her er alt hva' du skal bruge - og lidt til

henrikudsen - kan du komme med et eksempel- pls.
Jeg synes det er et kanon svar fra philiph - men du skal ha' chancen

Sorry, jeg havde ikke lige set du skulle ændre i filens attributer - troede bare du ville aflæse dem :o/