Results 1 to 2 of 2

Thread: vb6 GetFileTime,SetFileTime by Windows api

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    5,040

    vb6 GetFileTime,SetFileTime by Windows api

    When converting UTC time to Beijing time, an additional 8 hours are required.


    Code:
    Sub Test()
    SetFileTimes App.Path & "\test.txt", "2025-2-1", "2025-2-2 11:11:11", "2025-2-3 12:13:14"
     
    
    Dim CreationTime As Date, LastAccessTime As Date, LastWriteTime As Date
    GetFileTimes App.Path & "\test.txt", CreationTime, LastAccessTime, LastWriteTime
    Debug.Print "readFileTime:CreationTime=" & CreationTime & ",LastAccessTime=" & LastAccessTime & ",LastWriteTime=" & LastWriteTime
    
    End Sub
    Code:
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    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 Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    
    Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) 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 Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
    Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
    
    
    Private Const GENERIC_WRITE = &H40000000
    Private Const OPEN_EXISTING = 3
    Private Const FILE_SHARE_READ = &H1
    Private Const FILE_SHARE_WRITE = &H2
    
    
    Public Function SystemTimeToDate(st As SYSTEMTIME, Optional TimeZone As Long = 8) As Date
        '?????SYSTEMTIME?Date
        Dim dt As Date
        dt = DateAdd("h", TimeZone, DateSerial(st.wYear, st.wMonth, st.wDay) + _
             TimeSerial(st.wHour, st.wMinute, st.wSecond))
        SystemTimeToDate = dt
    End Function
    Public Function GetFileTimes(ByVal filePath As String, Optional CreationTime As Date _
        , Optional LastAccessTime As Date, Optional LastWriteTime As Date, Optional TimeZone As Long = 8) As Date
        Dim hFile As Long
        Dim ftCreation As FILETIME
        Dim ftLastAccess As FILETIME
        Dim ftLastWrite As FILETIME
        Dim st As SYSTEMTIME
    
        hFile = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
        If hFile = -1 Then
            Exit Function
        End If
        GetFileTime hFile, ftCreation, ftLastAccess, ftLastWrite
        FileTimeToSystemTime ftCreation, st:      CreationTime = SystemTimeToDate(st, TimeZone)
        FileTimeToSystemTime ftLastAccess, st:    LastAccessTime = SystemTimeToDate(st, TimeZone)
        FileTimeToSystemTime ftLastWrite, st:     LastWriteTime = SystemTimeToDate(st, TimeZone)
        
        CloseHandle hFile
        
        GetFileTimes = LastWriteTime
    End Function
    Public Function SetFileTimes(ByVal filePath As String, Optional ByVal CreationTime As Date _
        , Optional ByVal LastAccessTime As Date, Optional ByVal LastWriteTime As Date, Optional TimeZone As Long = 8) As Boolean
        'TimeZone=8 china/beijing
        Dim hFile As Long
        Dim ftCreation As FILETIME
        Dim ftLastAccess As FILETIME
        Dim ftLastWrite As FILETIME
        Dim st As SYSTEMTIME
    
        ' ??????
        hFile = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
        If hFile = -1 Then
            Exit Function
        End If
    
        If CreationTime <> 0 Then
        ' ?????FILETIME??
            With st
                .wYear = Year(CreationTime)
                .wMonth = Month(CreationTime)
                .wDay = Day(CreationTime)
                .wHour = Hour(CreationTime)
                .wMinute = Minute(CreationTime)
                .wSecond = Second(CreationTime)
            End With
            Call SystemTimeToFileTime(st, ftCreation)
            Call LocalFileTimeToFileTime(ftCreation, ftCreation)
        End If
        
        If LastAccessTime <> 0 Then
            With st
                .wYear = Year(LastAccessTime)
                .wMonth = Month(LastAccessTime)
                .wDay = Day(LastAccessTime)
                .wHour = Hour(LastAccessTime)
                .wMinute = Minute(LastAccessTime)
                .wSecond = Second(LastAccessTime)
            End With
            Call SystemTimeToFileTime(st, ftLastAccess)
            Call LocalFileTimeToFileTime(ftLastAccess, ftLastAccess)
        End If
        
        If LastWriteTime <> 0 Then
            With st
                .wYear = Year(LastWriteTime)
                .wMonth = Month(LastWriteTime)
                .wDay = Day(LastWriteTime)
                .wHour = Hour(LastWriteTime)
                .wMinute = Minute(LastWriteTime)
                .wSecond = Second(LastWriteTime)
            End With
            Call SystemTimeToFileTime(st, ftLastWrite)
            Call LocalFileTimeToFileTime(ftLastWrite, ftLastWrite)
        End If
        Call SetFileTime(hFile, ftCreation, ftLastAccess, ftLastWrite)
    
        Call CloseHandle(hFile)
        SetFileTimes = True
    End Function

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    5,040

    Re: vb6 GetFileTime,SetFileTime by Windows api

    Code:
    Private Function FileTimeToDate(FT As FILETIME, Optional TimeZone As Long = 8) As Date
        Dim st As SYSTEMTIME
        FileTimeToSystemTime FT, st
        FileTimeToDate = DateAdd("h", TimeZone, DateSerial(st.wYear, st.wMonth, st.wDay) + _
             TimeSerial(st.wHour, st.wMinute, st.wSecond))
    End Function
    
    Public Function GetFileTimes(ByVal filePath As String, Optional CreationTime As Date _
        , Optional LastAccessTime As Date, Optional LastWriteTime As Date, Optional TimeZone As Long = 8) As Date
        Dim hFile As Long
        Dim ftCreation As FILETIME, ftLastAccess As FILETIME, ftLastWrite As FILETIME
    
        hFile = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
        If hFile = -1 Then Exit Function
        GetFileTime hFile, ftCreation, ftLastAccess, ftLastWrite
        CreationTime = FileTimeToDate(ftCreation, TimeZone)
        LastAccessTime = FileTimeToDate(ftLastAccess, TimeZone)
        LastWriteTime = FileTimeToDate(ftLastWrite, TimeZone)
        
        CloseHandle hFile: GetFileTimes = LastWriteTime
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width