'This project needs a Common Dialog box, named CDBox. ' (To add the Common Dialog Box to your tools menu, go to Project->Components (or press CTRL-T) ' and select Microsoft Common Dialog control) 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 Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 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 FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) 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 Private Sub Form_Load() 'KPD-Team 1998 'URL: http://www.allapi.net/ '[email protected] Dim m_Date As Date, lngHandle As Long Dim udtFileTime As FILETIME Dim udtLocalTime As FILETIME Dim udtSystemTime As SYSTEMTIME m_Date = Format(Now, "DD-MM-YY") 'Set the dialog's title CDBox.DialogTitle = "Choose a file ..." 'Set the dialog's filter CDBox.Filter = "All Files (*.*)|*.*" 'Show the 'Open File'-dialog CDBox.ShowOpen udtSystemTime.wYear = Year(m_Date) udtSystemTime.wMonth = Month(m_Date) udtSystemTime.wDay = Day(m_Date) udtSystemTime.wDayOfWeek = WeekDay(m_Date) - 1 udtSystemTime.wHour = Hour(m_Date) udtSystemTime.wSecond = Second(m_Date) udtSystemTime.wMilliseconds = 0 ' convert system time to local time SystemTimeToFileTime udtSystemTime, udtLocalTime ' convert local time to GMT LocalFileTimeToFileTime udtLocalTime, udtFileTime ' open the file to get the filehandle lngHandle = CreateFile(CDBox.Filename, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) ' change date/time property of the file SetFileTime lngHandle, udtFileTime, udtFileTime, udtFileTime ' close the handle CloseHandle lngHandle MsgBox "The date of the file '" + CDBox.Filename + "' has been changed to" + Str$(m_Date), vbInformation + vbOKOnly, App.Title End Sub
'这个模块用于读取/修改文件的创建时间，最后访问时间和最后修改时间。 'SetTime函数更改文件创建时间，访问时间和修改时间，其参数如下： '第一个参数指定一个完整的文件路径及名称； '第二个参数指定新的创建时间，第三个参数指定新的最后访问时间，第四个参数指定新的最后修改时间。 '如： 'Private Sub Command1_Click() ' SetTime "c:\abc.txt", #12/20/1999 1:01:01 AM#, #8/8/2002 3:21:00 AM#, #7/1/1997 12:50:11 AM# 'End Sub ' 'GetTime函数获取文件的创建时间，访问时间或修改时间，其参数如下： '第一个参数指定一个完整的文件路径及名称，第二个参数指定要获取创建时间(theCreateTime)，访问时间(theLastAccessTime)还是最后修改时间(theLastWriteTime)，缺省为创建时间 '如：获取文件创建时间 'Private Sub Command1_Click() ' MsgBox GetTime("c:\abc.txt") 'End Sub '再如获取文件最后修改时间 'Private Sub Command1_Click() ' MsgBox GetTime("c:\abc.txt", theLastWriteTime) 'End Sub ' ' Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public Const OFS_MAXPATHNAME = 128 Public Type OFSTRUCT cBytes As Byte fFixedDisk As Byte nErrCode As Integer Reserved1 As Integer Reserved2 As Integer szPathName(OFS_MAXPATHNAME) As Byte End Type Public Const OF_READ = &H0 Public Const OF_READWRITE = &H2 Public 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 Public Type TIME_ZONE_INFORMATION bias As Long StandardName(32) As Integer StandardDate As SYSTEMTIME StandardBias As Long DaylightName(32) As Integer DaylightDate As SYSTEMTIME DaylightBias As Long End Type Public Type BY_HANDLE_FILE_INFORMATION dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME dwVolumeSerialNumber As Long nFileSizeHigh As Long nFileSizeLow As Long nNumberOfLinks As Long nFileIndexHigh As Long nFileIndexLow As Long End Type Public Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long Public Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long Public Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long Dim FileHandle As Long Dim OpenBuff As OFSTRUCT Dim tZone As TIME_ZONE_INFORMATION Dim sCreate As SYSTEMTIME Dim sAccess As SYSTEMTIME Dim sWrite As SYSTEMTIME Dim fCreate As FILETIME Dim fAccess As FILETIME Dim fWrite As FILETIME Dim bias As Long Dim theTime As Date Dim FileInfo As BY_HANDLE_FILE_INFORMATION Public Enum FileTimeOptions theCreateTime = 1 theLastAccessTime = 2 theLastWriteTime = 3 End EnumPublic Sub SetTime(ByVal FileName As String, ByVal CreateTime As Date, ByVal LastAccessTime As Date, ByVal LastWriteTime As Date)
'1,处理文件属性，去掉只读等属性, If Dir(FileName, 63) = "" Then Exit Sub SetAttr FileName, vbNormal
End Sub Public Function GetTime(ByVal FileName As String, Optional ByVal TimeOfFile As FileTimeOptions = theCreateTime) As Date If Dir(FileName, 63) = "" Then Exit Function FileHandle = OpenFile(FileName, OpenBuff, OF_READ) GetFileInformationByHandle FileHandle, FileInfo CloseHandle FileHandle GetTimeZoneInformation tZone bias = tZone.bias FileTimeToSystemTime FileInfo.ftCreationTime, sCreate FileTimeToSystemTime FileInfo.ftLastAccessTime, sAccess FileTimeToSystemTime FileInfo.ftLastWriteTime, sWrite
Dim CurTime As SYSTEMTIME Select Case TimeOfFile Case 1 CurTime = sCreate Case 2 CurTime = sAccess Case 3 CurTime = sWrite End Select GetTime = DateSerial(CurTime.wYear, CurTime.wMonth, CurTime.wDay) + TimeSerial(CurTime.wHour, CurTime.wMinute - bias, CurTime.wSecond)
' (To add the Common Dialog Box to your tools menu, go to Project->Components (or press CTRL-T)
' and select Microsoft Common Dialog control)
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 Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
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 FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) 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
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'[email protected]
Dim m_Date As Date, lngHandle As Long
Dim udtFileTime As FILETIME
Dim udtLocalTime As FILETIME
Dim udtSystemTime As SYSTEMTIME
m_Date = Format(Now, "DD-MM-YY") 'Set the dialog's title
CDBox.DialogTitle = "Choose a file ..."
'Set the dialog's filter
CDBox.Filter = "All Files (*.*)|*.*"
'Show the 'Open File'-dialog
CDBox.ShowOpen udtSystemTime.wYear = Year(m_Date)
udtSystemTime.wMonth = Month(m_Date)
udtSystemTime.wDay = Day(m_Date)
udtSystemTime.wDayOfWeek = WeekDay(m_Date) - 1
udtSystemTime.wHour = Hour(m_Date)
udtSystemTime.wSecond = Second(m_Date)
udtSystemTime.wMilliseconds = 0 ' convert system time to local time
SystemTimeToFileTime udtSystemTime, udtLocalTime
' convert local time to GMT
LocalFileTimeToFileTime udtLocalTime, udtFileTime
' open the file to get the filehandle
lngHandle = CreateFile(CDBox.Filename, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
' change date/time property of the file
SetFileTime lngHandle, udtFileTime, udtFileTime, udtFileTime
' close the handle
CloseHandle lngHandle
MsgBox "The date of the file '" + CDBox.Filename + "' has been changed to" + Str$(m_Date), vbInformation + vbOKOnly, App.Title
End Sub
'SetTime函数更改文件创建时间，访问时间和修改时间，其参数如下：
'第一个参数指定一个完整的文件路径及名称；
'第二个参数指定新的创建时间，第三个参数指定新的最后访问时间，第四个参数指定新的最后修改时间。
'如：
'Private Sub Command1_Click()
' SetTime "c:\abc.txt", #12/20/1999 1:01:01 AM#, #8/8/2002 3:21:00 AM#, #7/1/1997 12:50:11 AM#
'End Sub
'
'GetTime函数获取文件的创建时间，访问时间或修改时间，其参数如下：
'第一个参数指定一个完整的文件路径及名称，第二个参数指定要获取创建时间(theCreateTime)，访问时间(theLastAccessTime)还是最后修改时间(theLastWriteTime)，缺省为创建时间
'如：获取文件创建时间
'Private Sub Command1_Click()
' MsgBox GetTime("c:\abc.txt")
'End Sub
'再如获取文件最后修改时间
'Private Sub Command1_Click()
' MsgBox GetTime("c:\abc.txt", theLastWriteTime)
'End Sub
'
'
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Const OFS_MAXPATHNAME = 128
Public Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
Public Const OF_READ = &H0
Public Const OF_READWRITE = &H2
Public 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
Public Type TIME_ZONE_INFORMATION
bias As Long
StandardName(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Public Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
Public Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Public Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Public Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Dim FileHandle As Long
Dim OpenBuff As OFSTRUCT
Dim tZone As TIME_ZONE_INFORMATION
Dim sCreate As SYSTEMTIME
Dim sAccess As SYSTEMTIME
Dim sWrite As SYSTEMTIME
Dim fCreate As FILETIME
Dim fAccess As FILETIME
Dim fWrite As FILETIME
Dim bias As Long
Dim theTime As Date
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Public Enum FileTimeOptions
theCreateTime = 1
theLastAccessTime = 2
theLastWriteTime = 3
End EnumPublic Sub SetTime(ByVal FileName As String, ByVal CreateTime As Date, ByVal LastAccessTime As Date, ByVal LastWriteTime As Date)
'1,处理文件属性，去掉只读等属性,
If Dir(FileName, 63) = "" Then Exit Sub
SetAttr FileName, vbNormal
'2,处理时差
GetTimeZoneInformation tZone
bias = tZone.bias '时差，以分钟为单位,中国地区为早8小时，值-480。
theTime = TimeSerial(0, bias, 0)
CreateTime = CreateTime + theTime
LastAccessTime = LastAccessTime + theTime
LastWriteTime = LastWriteTime + theTime
'3,将SYSTEMTIME格式时间转换为FILETIME格式时间
sCreate.wDay = Day(CreateTime): sCreate.wHour = Hour(CreateTime): sCreate.wMinute = Minute(CreateTime): sCreate.wMonth = Month(CreateTime): sCreate.wSecond = Second(CreateTime): sCreate.wYear = Year(CreateTime)
sAccess.wDay = Day(LastAccessTime): sAccess.wHour = Hour(LastAccessTime): sAccess.wMinute = Minute(LastAccessTime): sAccess.wMonth = Month(LastAccessTime): sAccess.wSecond = Second(LastAccessTime): sAccess.wYear = Year(LastAccessTime)
sWrite.wDay = Day(LastWriteTime): sWrite.wHour = Hour(LastWriteTime): sWrite.wMinute = Minute(LastWriteTime): sWrite.wMonth = Month(LastWriteTime): sWrite.wSecond = Second(LastWriteTime): sWrite.wYear = Year(LastWriteTime)
SystemTimeToFileTime sCreate, fCreate
SystemTimeToFileTime sAccess, fAccess
SystemTimeToFileTime sWrite, fWrite
'4,修改文件时间
FileHandle = OpenFile(FileName, OpenBuff, OF_READWRITE)
SetFileTime FileHandle, fCreate, fAccess, fWrite '注:这里的三个时间采用的是格林尼治标准时间!
CloseHandle FileHandle
End Sub
Public Function GetTime(ByVal FileName As String, Optional ByVal TimeOfFile As FileTimeOptions = theCreateTime) As Date
If Dir(FileName, 63) = "" Then Exit Function
FileHandle = OpenFile(FileName, OpenBuff, OF_READ)
GetFileInformationByHandle FileHandle, FileInfo
CloseHandle FileHandle
GetTimeZoneInformation tZone
bias = tZone.bias
FileTimeToSystemTime FileInfo.ftCreationTime, sCreate
FileTimeToSystemTime FileInfo.ftLastAccessTime, sAccess
FileTimeToSystemTime FileInfo.ftLastWriteTime, sWrite
Dim CurTime As SYSTEMTIME
Select Case TimeOfFile
Case 1
CurTime = sCreate
Case 2
CurTime = sAccess
Case 3
CurTime = sWrite
End Select
GetTime = DateSerial(CurTime.wYear, CurTime.wMonth, CurTime.wDay) + TimeSerial(CurTime.wHour, CurTime.wMinute - bias, CurTime.wSecond)
End Function