1,451
社区成员
发帖
与我相关
我的任务
分享请发表友善的回复…
发表回复
nebbish 2003-06-24
- 打赏
- 举报
获取文件的创建日期、修改日期是很简单的，用 efei(草不含羞) 的方法就可以了，若要修改日期就必须要用Ａｐｉ了。
我有一个模块，共享了。
Option Explicit
Const Name = "modChangeFileTime"
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
Public Function ReadFileTime(strFile As String, dateCreat As Date, dateChange As Date, dateRead As Date) As Boolean
On Error GoTo ErrLine
ReadFileTime = False
Dim fso As New FileSystemObject
Dim fileOne As file
Set fileOne = fso.GetFile(strFile)
dateRead = fileOne.DateLastAccessed
dateCreat = fileOne.DateCreated
dateChange = fileOne.DateLastModified
ReadFileTime = True
Exit Function
ErrLine:
'SaveErr Name, "ReadFileTime"
End Function
Public Function ChangeFileTime(strFile As String, dateCreat As Date, dateChange As Date, dateRead As Date) As Boolean
On Error GoTo ErrLine
ChangeFileTime = False
Dim udtFileCreat As FILETIME
Dim udtFileChange As FILETIME
Dim udtFileRead As FILETIME
udtFileChange = DateToFileTime(dateChange)
udtFileCreat = DateToFileTime(dateCreat)
udtFileRead = DateToFileTime(dateRead)
Dim dateNow As Date
dateNow = Now
Dim lngHandle As Long
lngHandle = CreateFile(strFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
SetFileTime lngHandle, udtFileCreat, udtFileRead, udtFileChange
Date = dateRead
Time = dateRead
CloseHandle lngHandle
Date = dateNow
Time = dateNow
ChangeFileTime = True
Exit Function
ErrLine:
'SaveErr Name, "ChangeFileTime"
End Function
Private Function DateToFileTime(dateOne As Date) As FILETIME
Dim m_Date As Date, lngHandle As Long
Dim udtFileTime As FILETIME
Dim udtLocalTime As FILETIME
Dim udtSystemTime As SYSTEMTIME
m_Date = dateOne
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.wMinute = Minute(m_Date)
udtSystemTime.wSecond = Second(m_Date)
udtSystemTime.wMilliseconds = 0
SystemTimeToFileTime udtSystemTime, udtLocalTime
LocalFileTimeToFileTime udtLocalTime, udtFileTime
DateToFileTime = udtFileTime
End Function
注意要引用Microsoft Scripting Runtime
我有一个模块，共享了。
Option Explicit
Const Name = "modChangeFileTime"
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
Public Function ReadFileTime(strFile As String, dateCreat As Date, dateChange As Date, dateRead As Date) As Boolean
On Error GoTo ErrLine
ReadFileTime = False
Dim fso As New FileSystemObject
Dim fileOne As file
Set fileOne = fso.GetFile(strFile)
dateRead = fileOne.DateLastAccessed
dateCreat = fileOne.DateCreated
dateChange = fileOne.DateLastModified
ReadFileTime = True
Exit Function
ErrLine:
'SaveErr Name, "ReadFileTime"
End Function
Public Function ChangeFileTime(strFile As String, dateCreat As Date, dateChange As Date, dateRead As Date) As Boolean
On Error GoTo ErrLine
ChangeFileTime = False
Dim udtFileCreat As FILETIME
Dim udtFileChange As FILETIME
Dim udtFileRead As FILETIME
udtFileChange = DateToFileTime(dateChange)
udtFileCreat = DateToFileTime(dateCreat)
udtFileRead = DateToFileTime(dateRead)
Dim dateNow As Date
dateNow = Now
Dim lngHandle As Long
lngHandle = CreateFile(strFile, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
SetFileTime lngHandle, udtFileCreat, udtFileRead, udtFileChange
Date = dateRead
Time = dateRead
CloseHandle lngHandle
Date = dateNow
Time = dateNow
ChangeFileTime = True
Exit Function
ErrLine:
'SaveErr Name, "ChangeFileTime"
End Function
Private Function DateToFileTime(dateOne As Date) As FILETIME
Dim m_Date As Date, lngHandle As Long
Dim udtFileTime As FILETIME
Dim udtLocalTime As FILETIME
Dim udtSystemTime As SYSTEMTIME
m_Date = dateOne
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.wMinute = Minute(m_Date)
udtSystemTime.wSecond = Second(m_Date)
udtSystemTime.wMilliseconds = 0
SystemTimeToFileTime udtSystemTime, udtLocalTime
LocalFileTimeToFileTime udtLocalTime, udtFileTime
DateToFileTime = udtFileTime
End Function
注意要引用Microsoft Scripting Runtime
jordi2014 2003-06-24
- 打赏
- 举报
FileDateTime
efei 2003-06-24
- 打赏
- 举报
给个使用示例吧
efei 2003-06-24
- 打赏
- 举报
那lpdata怎么确定？随便填啊？
penglc 2003-06-24
- 打赏
- 举报
参数表：
lptstrFilename - String，欲从中载入版本信息的一个文件的名字
dwHandle ------- Long，win32中未用
dwLen ---------- Long，由lpData参数指定的字节数组或缓冲区的大小。用GetFileVersionInfoSize函数判断要求的缓冲区长度有多大
lpData --------- Byte，指定一个字节缓冲区的第一个字节。该缓冲区用于装载文件的版本信息
lptstrFilename - String，欲从中载入版本信息的一个文件的名字
dwHandle ------- Long，win32中未用
dwLen ---------- Long，由lpData参数指定的字节数组或缓冲区的大小。用GetFileVersionInfoSize函数判断要求的缓冲区长度有多大
lpData --------- Byte，指定一个字节缓冲区的第一个字节。该缓冲区用于装载文件的版本信息
efei 2003-06-24
- 打赏
- 举报
这么复杂……
我看网上找到一个，用fso的
Dim file As Variant
Dim fso As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(.filename)
MsgBox vbLf & "创建时间：" & file.DateCreated & _
vbLf & "修改时间：" & file.DateLastModified & _
vbLf & "访问时间：" & file.DateLastAccessed
另外还有一个问题，就是获取文件版本，可以使用
Declare Function GetFileVersionInfo Lib "version.dll" _
Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, _
ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
但是我对其中的一些参数意思不太明白。
lptstrfilename自然是文件的名字，应该是包括全路径的；后面三个参数是什么意思我就不太懂了，特别的，最后一个类型是any，这是什么东东？
我看网上找到一个，用fso的
Dim file As Variant
Dim fso As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(.filename)
MsgBox vbLf & "创建时间：" & file.DateCreated & _
vbLf & "修改时间：" & file.DateLastModified & _
vbLf & "访问时间：" & file.DateLastAccessed
另外还有一个问题，就是获取文件版本，可以使用
Declare Function GetFileVersionInfo Lib "version.dll" _
Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, _
ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
但是我对其中的一些参数意思不太明白。
lptstrfilename自然是文件的名字，应该是包括全路径的；后面三个参数是什么意思我就不太懂了，特别的，最后一个类型是any，这是什么东东？
lxcc 2003-06-24
- 打赏
- 举报
FileDateTime
'最后编辑事件
'最后编辑事件
dandy1437 2003-06-24
- 打赏
- 举报
读取文件的建立时间及存取时间
想要进一步读取文件的相关资讯， 必须先呼叫 API 函数的 OpenFile 取得文件的
Handle， 然後再利用 Handle 呼叫 GetFileInformationByHandle 读取文件的相关
资讯， 而在读取的文件相关资讯中便含有文件建立、修改、及存取时间， 程式执
行过程如下：(假设想读取的文件是"c:\autoexec.bat")
REF 更改文件日期时间
Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0
Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
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
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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
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
Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _
lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As _
Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As _
FileTime, lpSystemTime As SYSTEMTIME) As Long
Dim FileHandle As Long
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Dim lpReOpenBuff As OFSTRUCT, ft As SYSTEMTIME
Dim tZone As TIME_ZONE_INFORMATION
Dim dtCreate As Date ' 建立时间
Dim dtAccess As Date ' 存取日期
Dim dtWrite As Date ' 修改时间
Dim bias As Long
' 先取得 autoexec.bat 的 File Handle
FileHandle = OpenFile("c:\autoexec.bat", lpReOpenBuff, OF_READ)
' 利用 File Handle 读取文件资讯
Call GetFileInformationByHandle(FileHandle, FileInfo)
Call CloseHandle(FileHandle)
' 读取 Time Zone 资讯， 因为上一步骤的文件时间是「格林威治」时间
Call GetTimeZoneInformation(tZone)
bias = tZone.bias ' 时间差， 以「分」为单位
Call FileTimeToSystemTime(FileInfo.ftCreationTime, ft) ' 转换时间资料结构
dtCreate = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + ;
TimeSerial(ft.wHour, ft.wMinute - bias, ft.wSecond)
Call FileTimeToSystemTime(FileInfo.ftLastAccessTime, ft)
dtAccess = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + ;
TimeSerial(ft.wHour, ft.wMinute - bias,ft.wSecond)
Call FileTimeToSystemTime(FileInfo.ftLastWriteTime, ft)
dtWrite = DateSerial(ft.wYear, ft.wMonth, ft.wDay) +
TimeSerial(ft.wHour, ft.wMinute - bias,ft.wSecond)
'执行以上程式所得到的 dtCreate、dtWrite、及 dtAccess 变数， 即分别为文件
'建立、修改、及存取时间。
想要进一步读取文件的相关资讯， 必须先呼叫 API 函数的 OpenFile 取得文件的
Handle， 然後再利用 Handle 呼叫 GetFileInformationByHandle 读取文件的相关
资讯， 而在读取的文件相关资讯中便含有文件建立、修改、及存取时间， 程式执
行过程如下：(假设想读取的文件是"c:\autoexec.bat")
REF 更改文件日期时间
Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0
Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
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
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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
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
Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _
lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As _
Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As _
FileTime, lpSystemTime As SYSTEMTIME) As Long
Dim FileHandle As Long
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Dim lpReOpenBuff As OFSTRUCT, ft As SYSTEMTIME
Dim tZone As TIME_ZONE_INFORMATION
Dim dtCreate As Date ' 建立时间
Dim dtAccess As Date ' 存取日期
Dim dtWrite As Date ' 修改时间
Dim bias As Long
' 先取得 autoexec.bat 的 File Handle
FileHandle = OpenFile("c:\autoexec.bat", lpReOpenBuff, OF_READ)
' 利用 File Handle 读取文件资讯
Call GetFileInformationByHandle(FileHandle, FileInfo)
Call CloseHandle(FileHandle)
' 读取 Time Zone 资讯， 因为上一步骤的文件时间是「格林威治」时间
Call GetTimeZoneInformation(tZone)
bias = tZone.bias ' 时间差， 以「分」为单位
Call FileTimeToSystemTime(FileInfo.ftCreationTime, ft) ' 转换时间资料结构
dtCreate = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + ;
TimeSerial(ft.wHour, ft.wMinute - bias, ft.wSecond)
Call FileTimeToSystemTime(FileInfo.ftLastAccessTime, ft)
dtAccess = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + ;
TimeSerial(ft.wHour, ft.wMinute - bias,ft.wSecond)
Call FileTimeToSystemTime(FileInfo.ftLastWriteTime, ft)
dtWrite = DateSerial(ft.wYear, ft.wMonth, ft.wDay) +
TimeSerial(ft.wHour, ft.wMinute - bias,ft.wSecond)
'执行以上程式所得到的 dtCreate、dtWrite、及 dtAccess 变数， 即分别为文件
'建立、修改、及存取时间。
