修改文件创建、修改、访问时间

Option Explicit

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal NoSecurity 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 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 SetFileCreatedTime Lib "kernel32" Alias "SetFileTime" (ByVal hFile As Long, lpCreationTime As FILETIME, ByVal NullLastAccessTime As Long, ByVal NullLastWriteTime As Long) As Long
Private Declare Function SetFileAccessTime Lib "kernel32" Alias "SetFileTime" (ByVal hFile As Long, ByVal NullCreationTime As Long, lpLastAccessTime As FILETIME, ByVal NullWriteTime As Long) As Long
Private Declare Function SetFileModifiedTime Lib "kernel32" Alias "SetFileTime" (ByVal hFile As Long, ByVal NullCreationTime As Long, ByVal NullLastAccessTime As Long, lpLastWriteTime As FILETIME) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3

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 FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long

Private Function SystemTimeToDate(system_time As SYSTEMTIME) As Date
With system_time
SystemTimeToDate = CDate( _
Format$(.wMonth) & "/" & _
Format$(.wDay) & "/" & _
Format$(.wYear) & " " & _
Format$(.wHour) & ":" & _
Format$(.wMinute, "00") & ":" & _
Format$(.wSecond, "00"))
End With
End Function
' Convert a Date into a SYSTEMTIME.
Private Function DateToSystemTime(ByVal the_date As Date) As SYSTEMTIME
With DateToSystemTime
.wYear = Year(the_date)
.wMonth = Month(the_date)
.wDay = Day(the_date)
.wHour = Hour(the_date)
.wMinute = Minute(the_date)
.wSecond = Second(the_date)
End With
End Function

' Convert the FILETIME structure into a Date.
Private Function FileTimeToDate(file_time As FILETIME) As Date
Dim system_time As SYSTEMTIME

' Convert the FILETIME into a SYSTEMTIME.
FileTimeToSystemTime file_time, system_time

' Convert the SYSTEMTIME into a Date.
FileTimeToDate = SystemTimeToDate(system_time)
End Function
' Convert a Date into a FILETIME structure.
Private Function DateToFileTime(ByVal the_date As Date) As FILETIME
Dim system_time As SYSTEMTIME
Dim file_time As FILETIME

' Convert the Date into a SYSTEMTIME.
system_time = DateToSystemTime(the_date)

' Convert the SYSTEMTIME into a FILETIME.
SystemTimeToFileTime system_time, file_time
DateToFileTime = file_time
End Function
' Return True if there is an error.
Private Function GetFileTimes(ByVal file_name As String, ByRef creation_date As Date, ByRef access_date As Date, ByRef modified_date As Date, ByVal local_time As Boolean) As Boolean
Dim file_handle As Long
Dim creation_filetime As FILETIME
Dim access_filetime As FILETIME
Dim modified_filetime As FILETIME
Dim file_time As FILETIME

' Assume something will fail.
GetFileTimes = True

' Open the file.
file_handle = CreateFile(file_name, GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0&, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then Exit Function

' Get the times.
If GetFileTime(file_handle, creation_filetime, access_filetime, modified_filetime) = 0 Then
CloseHandle file_handle
Exit Function
End If

' Close the file.
If CloseHandle(file_handle) = 0 Then Exit Function

' See if we should convert to the local
' file system time.
If local_time Then
' Convert to local file system time.
FileTimeToLocalFileTime creation_filetime, file_time
creation_filetime = file_time

FileTimeToLocalFileTime access_filetime, file_time
access_filetime = file_time

FileTimeToLocalFileTime modified_filetime, file_time
modified_filetime = file_time
End If

' Convert into dates.
creation_date = FileTimeToDate(creation_filetime)
access_date = FileTimeToDate(access_filetime)
modified_date = FileTimeToDate(modified_filetime)

GetFileTimes = False
End Function
' Return True if there is an error.
Private Function SetFileTimes(ByVal file_name As String, ByVal creation_date As Date, ByVal access_date As Date, ByVal modified_date As Date, ByVal local_times As Boolean) As Boolean
Dim file_handle As Long
Dim creation_filetime As FILETIME
Dim access_filetime As FILETIME
Dim modified_filetime As FILETIME
Dim file_time As FILETIME

' Assume something will fail.
SetFileTimes = True

' Convert the dates into FILETIMEs.
creation_filetime = DateToFileTime(creation_date)
access_filetime = DateToFileTime(access_date)
modified_filetime = DateToFileTime(modified_date)

' Convert the file times into system file times.
If local_times Then
LocalFileTimeToFileTime creation_filetime, file_time
creation_filetime = file_time

LocalFileTimeToFileTime access_filetime, file_time
access_filetime = file_time

LocalFileTimeToFileTime modified_filetime, file_time
modified_filetime = file_time
End If

' Open the file.
file_handle = CreateFile(file_name, GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0&, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then Exit Function

'creation_date = FileTimeToDate(creation_filetime)

' Set the times.
If SetFileTime(file_handle, creation_filetime, access_filetime, modified_filetime) = 0 Then
CloseHandle file_handle
Exit Function
End If

' Close the file.
If CloseHandle(file_handle) = 0 Then Exit Function

SetFileTimes = False
End Function
' Return True if there is an error.
Private Function SetFileModifiedDate(ByVal file_name As String, ByVal modified_date As Date, ByVal local_times As Boolean) As Boolean
Dim file_handle As Long
Dim modified_filetime As FILETIME
Dim file_time As FILETIME

' Assume something will fail.
SetFileModifiedDate = True

' Convert the date into a FILETIME.
modified_filetime = DateToFileTime(modified_date)

' Convert the file time into a system file time.
If local_times Then
LocalFileTimeToFileTime modified_filetime, file_time
modified_filetime = file_time
End If

' Open the file.
file_handle = CreateFile(file_name, GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0&, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then Exit Function

' Set the time.
If SetFileModifiedTime(file_handle, ByVal 0&, ByVal 0&, modified_filetime) = 0 Then
CloseHandle file_handle
Exit Function
End If

' Close the file.
If CloseHandle(file_handle) = 0 Then Exit Function

SetFileModifiedDate = False
End Function
' Return True if there is an error.
Private Function SetFileAccessedDate(ByVal file_name As String, ByVal accessed_date As Date, ByVal local_times As Boolean) As Boolean
Dim file_handle As Long
Dim accessed_filetime As FILETIME
Dim file_time As FILETIME

' Assume something will fail.
SetFileAccessedDate = True

' Convert the date into a FILETIME.
accessed_filetime = DateToFileTime(accessed_date)

' Convert the file time into a system file time.
If local_times Then
LocalFileTimeToFileTime accessed_filetime, file_time
accessed_filetime = file_time
End If

' Open the file.
file_handle = CreateFile(file_name, GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0&, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then Exit Function

' Set the time.
If SetFileAccessTime(file_handle, ByVal 0&, accessed_filetime, ByVal 0&) = 0 Then
CloseHandle file_handle
Exit Function
End If

' Close the file.
If CloseHandle(file_handle) = 0 Then Exit Function

SetFileAccessedDate = False
End Function

' Return True if there is an error.
Private Function SetFileCreatedDate(ByVal file_name As String, ByVal created_date As Date, ByVal local_times As Boolean) As Boolean
Dim file_handle As Long
Dim created_filetime As FILETIME
Dim file_time As FILETIME

' Assume something will fail.
SetFileCreatedDate = True

' Convert the date into a FILETIME.
created_filetime = DateToFileTime(created_date)

' Convert the file time into a system file time.
If local_times Then
LocalFileTimeToFileTime created_filetime, file_time
created_filetime = file_time
End If

' Open the file.
file_handle = CreateFile(file_name, GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0&, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then Exit Function

' Set the time.
If SetFileCreatedTime(file_handle, created_filetime, ByVal 0&, ByVal 0&) = 0 Then
CloseHandle file_handle
Exit Function
End If

' Close the file.
If CloseHandle(file_handle) = 0 Then Exit Function

SetFileCreatedDate = False
End Function

Private Sub Command1_Click()
Dim date_created As Date
Dim date_accessed As Date
Dim date_modified As Date

txtCreationTime.Text = ""
txtLastAccessedTime.Text = ""
txtLastModifiedTime.Text = ""

' Get the local file system times.
If GetFileTimes(Text1.Text, date_created, date_accessed, date_modified, True) Then
txtCreationTime.Text = "Error"
Else
txtCreationTime.Text = Format$(date_created)
txtLastAccessedTime.Text = Format$(date_accessed)
txtLastModifiedTime.Text = Format$(date_modified)
End If
End Sub

' Set the file times.
'
' Note that setting the modification time counts as accessing
' the file so that sets the access time. Therefore, if you want
' to set the access time, you must do it last.
Private Sub Command2_Click()
If Len(Trim$(txtCreationTime.Text)) > 0 Then
If SetFileCreatedDate(Text1.Text, txtCreationTime.Text, True) Then
MsgBox "Error setting creation time"
End If
End If
If Len(Trim$(txtLastModifiedTime.Text)) > 0 Then
If SetFileModifiedDate(Text1.Text, txtLastModifiedTime.Text, True) Then
MsgBox "Error setting last modification time"
End If
End If
If Len(Trim$(txtLastAccessedTime.Text)) > 0 Then
If SetFileAccessedDate(Text1.Text, txtLastAccessedTime.Text, True) Then
MsgBox "Error setting last access time"
End If
End If
MsgBox "Done"
End Sub

Private Sub Form_Load()
Dim file_name As String

file_name = App.Path
If Right$(file_name, 1) <> "/" Then file_name = file_name & "/"
file_name = file_name & "test.txt"
Text1 = file_name
End Sub