Public Function SetFileTimeStamp(ByVal sFile As String, ByVal vDate As Date, _
  ByVal SetFileTimeStampEnum As eSetFileTimeStampEnum) As Boolean
On Error Resume Next
Dim hFile As Long, OFS As OFSTRUCT, lReturn As Long
Dim CreationTime As FileTime, LastWriteTime As FileTime, LastAccessTime As _
  FileTime
hFile = OpenFile(sFile, OFS, OF_WRITE)
If hFile <> HFILE_ERROR Then
    lReturn = GetFileTime(hFile, CreationTime, LastAccessTime, LastWriteTime)
    CreationTime = VBDateToFileTime(vDate)
    Select Case SetFileTimeStampEnum
    Case eSetFileCreationTime
        CreationTime = VBDateToFileTime(vDate)
    Case eSetFileLastWriteTime
        LastWriteTime = VBDateToFileTime(vDate)
    Case eSetFileLastAccessTime
        LastAccessTime = VBDateToFileTime(vDate)
    End Select
    SetFileTimeStamp = SetFileTime(hFile, CreationTime, LastAccessTime, _
      LastWriteTime) <> 0
    lReturn = CloseHandle(hFile)
End If
End Function
 
Public Function GetFileTimeStamp(ByVal sFile, ByRef GetFileTimeStampType As _
  tGetFileTimeStampType) As Boolean
On Error Resume Next
Dim hFile As Long, OFS As OFSTRUCT, lReturn As Long
Dim CreationTime As FileTime, LastWriteTime As FileTime, LastAccessTime As _
  FileTime
hFile = OpenFile(sFile, OFS, OF_READ)
If hFile <> HFILE_ERROR Then
    ' file was successfully opened
    If GetFileTime(hFile, CreationTime, LastAccessTime, LastWriteTime) <> 0 Then
        ' succeeded in getting time stamps
        With GetFileTimeStampType
            .CreationTime = FileTimeToVBDate(CreationTime)
            .LastAccessTime = FileTimeToVBDate(LastAccessTime)
            .LastWriteTime = FileTimeToVBDate(LastWriteTime)
        End With
        GetFileTimeStamp = True
    End If
    lReturn = CloseHandle(hFile)
End If
End Function
 
Private Function FileTimeToVBDate(ByRef FileTime As FileTime) As Date
On Error Resume Next
Dim SysTime As SYSTEMTIME, vDate As Date, lReturn As Long
' convert to local timezone
lReturn = FileTimeToLocalFileTime(FileTime, FileTime)
' convert to systemtime type
lReturn = FileTimeToSystemTime(FileTime, SysTime)
' convert from systemtime type to VB date type
With SysTime
    vDate = DateSerial(.wYear, .wMonth, .wDay)
    vDate = DateAdd("h", .wHour, vDate)
    vDate = DateAdd("n", .wMinute, vDate)
    vDate = DateAdd("s", .wSecond, vDate)
End With
FileTimeToVBDate = vDate
End Function
 
Private Function VBDateToFileTime(ByRef vDate As Date) As FileTime
On Error Resume Next
Dim SysTime As SYSTEMTIME, lReturn As Long, FileTime As FileTime
'convert to systemtime type
With SysTime
    .wYear = Year(vDate)
    .wMonth = Month(vDate)
    .wDay = Day(vDate)
    .wHour = Hour(vDate)
    .wMinute = Minute(vDate)
    .wSecond = Second(vDate)
End With
'convert to filetime type
lReturn = SystemTimeToFileTime(SysTime, FileTime)
'convert to a Coordinated Universal Time (UTC) based filetime
lReturn = LocalFileTimeToFileTime(FileTime, FileTime)
VBDateToFileTime = FileTime
End Function

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.