如果取得可执行文件的编译日期？

[goj2000]

请各位大使指教：
如果取得可执行文件的编译日期？
就象app.path可取得执行文件路径 或 app.Major取得执行文件的版本号一样，如何取得可执行文件的编译日期和时间？
100分相送，说到做到。

[xfyxq]

没有编译日期，只有修改日期可能接近你的想法。求修改日期可以用FSO或是API

[hcj2002]

你可以得到文件的属性察看文件的创建日期。

[goj2000]

能否说得详细一些，我手头关于FSO的资料很少，能否提供一下？我的电子邮件地址是：[e-mail]
或提供下载地址。
非常感谢。

[华芸智森]

关于FSO的一些操作.

'工程==>引用==>Microsoft Scripting Runtime

Option Explicit

Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
"GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, _
lpFreeBytesAvailableToCaller As Any, lpTotalNumberOfBytes _
As Any, lpTotalNumberOfFreeBytes As Any) As Long

'磁盘信息结构
Type DriveInfo
DriveName As String '代号或路径
DriveType As String '类型
DriveVolume As String '卷标
DriveNumber As String '序列号
DriveFileSystem As String '文件系统
DriveSize As String '驱动器大小
DriveFree As String '可用空间
DriveIsReady As String '是否可用
End Type

'文件夹信息结构
Type FoldInfo
Attr As String '属性
Size As String '大小
DateCreated As String '建立日期
DateLastAcce As String '最后一次存取日期
DateLastModified As String '最后一次修改日期
End Type

'文件信息结构
Type FileInfo
Attr As String '属性
Rname As String '后缀名
Size As String '大小
DateCreated As String '建立日期
DateLastAcce As String '最后一次存取日期
DateLastModified As String '最后一次修改日期
End Type

Public SelDriveInfo As DriveInfo
Public SelFoldInfo As FoldInfo
Public SelFileInfo As FileInfo
Public AttrRHSA(3, 1) As String


'取磁盘信息 返回值:文件路径
Public Function GetDrives() As String
Dim Fs As New FileSystemObject
Dim Dr As Drive
Dim Dname As String
Dim DFname As String
Dim Fid As Long
Dim InputLine As String

On Error Resume Next

Fid = FreeFile
DFname = AppPath & "Temp\DRIVELIST.LIS"
Open DFname For Output As #Fid
For Each Dr In Fs.Drives
Dname = Dr.Path: Call ShowDriveInfo(Dname): DoEvents
'名称,类型,卷标,序列号,文件系统,磁盘大小,可用空间,是否可用
InputLine = SelDriveInfo.DriveName & Chr(vbKeyTab) & _
SelDriveInfo.DriveType & Chr(vbKeyTab) & _
SelDriveInfo.DriveVolume & Chr(vbKeyTab) & _
SelDriveInfo.DriveNumber & Chr(vbKeyTab) & _
SelDriveInfo.DriveFileSystem & Chr(vbKeyTab) & _
SelDriveInfo.DriveSize & Chr(vbKeyTab) & _
SelDriveInfo.DriveFree & Chr(vbKeyTab) & _
SelDriveInfo.DriveIsReady
Print #Fid, InputLine
Next
Close #Fid
GetDrives = DFname
End Function

'取目录下的目录 SPATH:所取的目录名 返回值:文件路径
Public Function GetFolders(sPath As String) As String
Dim Fs As New FileSystemObject
Dim Fd As Folder
Dim sFd As Folder
Dim SelFD As String
Dim Lname As String
Dim FLine As String
Dim FFname As String
Dim Fid As Long

On Error Resume Next

Fid = FreeFile
FFname = AppPath & "Temp\FolderList.Lis"
Call FAattr
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Set Fd = Fs.GetFolder(sPath)
Open FFname For Output As #Fid
For Each sFd In Fd.SubFolders
If CanFlag Then Close #Fid: CanFlag = False: Kill FFname: GetFolders = "CANCTRL": Exit Function '取消操作
SelFD = sFd.Name
'名称 类型 长度 属性 建立时间 最后一次存取时间 最后一次修改时间
Call ShowFolderInfo(sPath & SelFD) '取目录信息
DoEvents
FLine = SelFD & Chr(vbKeyTab) & _
"文件夹" & Chr(vbKeyTab) & _
SelFoldInfo.Size & Chr(vbKeyTab) & _
SelFoldInfo.Attr & Chr(vbKeyTab) & _
SelFoldInfo.DateCreated & Chr(vbKeyTab) & _
SelFoldInfo.DateLastAcce & Chr(vbKeyTab) & _
SelFoldInfo.DateLastModified
Print #Fid, FLine
Next
Close #Fid
GetFolders = FFname
End Function

'取目录下的文件 SPATH 所取的目录名 返回值:文件路径
Public Function GetFiles(sPath As String) As String
Dim Fs As New FileSystemObject
Dim Fd As Folder
Dim F As File
Dim Fname As String
Dim FLine As String
Dim FFname As String
Dim Fid As Long
Dim Fmax As Long

On Error Resume Next
Fid = FreeFile
Call FAattr
'名称 后缀名 长度 属性 建立时间 最后一次存取时间 最后一次修改时间
If Len(sPath) = 0 Then Exit Function
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Fid = FreeFile: FLine = "": FFname = ""
FFname = AppPath & "Temp\FILELIST.Lis"
Open FFname For Output As #Fid
Set Fd = Fs.GetFolder(sPath)
For Each F In Fd.Files
If CanFlag Then CanFlag = False: Close #Fid: Kill FFname: GetFiles = "CANCTRL": Exit Function '取消操作
Fname = F.Name
Call ShowFileInfo(sPath & Fname) '取文件信息
Fmax = Fmax + 1
If Len(FLine) = 0 Then
FLine = "" & Chr(vbKeyTab) & _
Fname & Chr(vbKeyTab) & _
SelFileInfo.Rname & Chr(vbKeyTab) & _
SelFileInfo.Size & Chr(vbKeyTab) & _
SelFileInfo.Attr & Chr(vbKeyTab) & _
SelFileInfo.DateCreated & Chr(vbKeyTab) & _
SelFileInfo.DateLastAcce & Chr(vbKeyTab) & _
SelFileInfo.DateLastModified
Else
FLine = FLine & Chr(13) & "" & Chr(vbKeyTab) & _
Fname & Chr(vbKeyTab) & _
SelFileInfo.Rname & Chr(vbKeyTab) & _
SelFileInfo.Size & Chr(vbKeyTab) & _
SelFileInfo.Attr & Chr(vbKeyTab) & _
SelFileInfo.DateCreated & Chr(vbKeyTab) & _
SelFileInfo.DateLastAcce & Chr(vbKeyTab) & _
SelFileInfo.DateLastModified
End If
If Fmax Mod 50 = 0 Then
Print #Fid, FLine
FLine = ""
End If
Next
If Fmax < 50 Then
Print #Fid, FLine
Else
If Fmax Mod 50 <> 0 Then Print #Fid, FLine
End If
EndHand:
Close #Fid
GetFiles = FFname
End Function

[华芸智森]

'*******************************************************88888
'文件的复制 sourfile 源文件名,OBJFILE 目标文件名
Function FileCopy(SourFile As String, ObjFile As String) As Boolean '文件复制
Dim Fs As New FileSystemObject
On Error Resume Next
Fs.CopyFile SourFile, ObjFile, True
If Err.Number <> 0 Then
Err.Clear
FileCopy = False
Else
FileCopy = True
End If
End Function

'文件移动 SOURFILE 源文件名,OBJFILE 目标文件名
Function FileMove(SourFile As String, ObjFile As String) As Boolean '文件移动
Dim Fs As New FileSystemObject
On Error Resume Next
Fs.MoveFile SourFile, ObjFile
If Err.Number <> 0 Then
Err.Clear
FileMove = False
Else
FileMove = True
End If
End Function

'文件更名 SOURFILE 源文件名.OBJFILE 更改后的名字(绝对路径)
Function FileRename(SourFile As String, ObjFile As String) As Boolean '文件改名
Dim Fs As New FileSystemObject
On Error Resume Next
SetAttr SourFile, 0
Call FileCopy(SourFile, ObjFile)
Call FileDel(SourFile)
If Err.Number <> 0 Then
Err.Clear
FileRename = False
Else
FileRename = True
End If
End Function

'文件删除 SOURFILE 删除的文件名称
Function FileDel(SourFile As String) As Boolean
Dim Fs As New FileSystemObject
On Error Resume Next
SetAttr SourFile, 0 '取消一切属性
Fs.DeleteFile SourFile, True
If Err.Number <> 0 Then
Err.Clear
FileDel = False
Else
FileDel = True
End If
End Function

'文件夹的复制 SOURFOLDER 源文件夹名,OBJFILDER 目标文件夹名
Function FolderCopy(SourFolder As String, ObjFolder As String) As Boolean
Dim Fs As New FileSystemObject
On Error Resume Next
Fs.CopyFolder SourFolder, ObjFolder, True
If Err.Number <> 0 Then
Err.Clear
FolderCopy = False
Else
FolderCopy = True
End If
End Function

'文件夹的移动 SOURFILDER 源文件夹名, OBJFOLDER 目标文件夹名
Function FolderMove(SourFolder As String, ObjFolder As String) As Boolean
Dim Fs As New FileSystemObject
On Error Resume Next
Fs.MoveFolder SourFolder, ObjFolder
If Err.Number <> 0 Then
Err.Clear
FolderMove = False
Else
FolderMove = True
End If
End Function

'文件夹的删除 SOURFOLDER 删除的文件夹名称
Function FolderDel(SourFolder As String) As Boolean
Dim Fs As New FileSystemObject
On Error Resume Next
Fs.DeleteFolder SourFolder, True
If Err.Number <> 0 Then
Err.Clear
FolderDel = False
Else
FolderDel = True
End If
End Function

'文件夹改名
Function FolderRename(SourFolder As String, ObjFolder As String) As Boolean
Dim Fs As New FileSystemObject
On Error Resume Next
If Right(SourFolder, 1) = "\" Then SourFolder = Left(SourFolder, Len(SourFolder) - 1)
If Right(ObjFolder, 1) = "\" Then ObjFolder = Left(ObjFolder, Len(ObjFolder) - 1)
Fs.MoveFolder SourFolder, ObjFolder
If Err.Number <> 0 Then
Err.Clear
FolderRename = False
Else
FolderRename = True
End If
End Function

'建立新文件夹
Function CreateFolder(SourFolder As String, NewFolderName As String) As Boolean
'新文件的路径,新文件夹名称
Dim Fs As New FileSystemObject
If Right(SourFolder, 1) <> "\" Then SourFolder = SourFolder & "\"
On Error Resume Next
Fs.CreateFolder SourFolder & NewFolderName
If Err.Number <> 0 Then
Err.Clear
CreateFolder = False
Else
CreateFolder = True
End If
End Function

Function ShowVolumeInfo(DriveName As String, VolueName As String) '设置卷标
Dim Fs As New FileSystemObject
Dim Dr As Drive
On Error Resume Next
Set Dr = Fs.GetDrive(DriveName)
Dr.VolumeName = VolueName
End Function

'***************************************************************************************
'***************************************************************************************
'***************************************************************************************
'----------------------------------------------------------------------------------------

Public Function ShowDriveInfo(DriveName As String) As Boolean '取磁盘信息
Dim C1 As Currency
Dim C2 As Currency
Dim C3 As Currency
Dim A1 As Long
Dim Fs As New FileSystemObject
Dim Dr As Drive

'"可用空间:" & Format((C1 * 10000) / 1024 / 1024 / 1024, "0.00GB")
On Error Resume Next
Set Dr = Fs.GetDrive(DriveName)
SelDriveInfo.DriveName = ""
SelDriveInfo.DriveIsReady = ""
SelDriveInfo.DriveType = ""
SelDriveInfo.DriveVolume = ""
SelDriveInfo.DriveNumber = ""
SelDriveInfo.DriveFileSystem = ""
SelDriveInfo.DriveSize = ""
SelDriveInfo.DriveFree = ""
'------------------------------------------
SelDriveInfo.DriveName = Dr.Path '代号或路径
GetDiskFreeSpaceEx DriveName, C1, C2, C3
If Left(DriveName, 2) = "A:" Then Exit Function '不用检测软盘的可用性
SelDriveInfo.DriveIsReady = Dr.IsReady '是否可用
SelDriveInfo.DriveType = Dr.DriveType '类型
SelDriveInfo.DriveVolume = Dr.VolumeName '卷标
SelDriveInfo.DriveNumber = Hex(Dr.SerialNumber) '序列号
SelDriveInfo.DriveFileSystem = Dr.FileSystem '文件系统
SelDriveInfo.DriveSize = C2 * 10000 '驱动器大小
SelDriveInfo.DriveFree = C1 * 10000 '可用空间
End Function

Public Function ShowFileInfo(Filename As String) '取文件信息
Dim Fs As New FileSystemObject
Dim F As File
Dim RetuAttr As Long
Dim FdAttr As String
Dim a As Long
Dim Fsize As Long

Fsize = 0
Set F = Fs.GetFile(Filename)
RetuAttr = F.Attributes
For a = 0 To 3
If (RetuAttr And CInt(AttrRHSA(a, 0))) <> 0 Then
FdAttr = FdAttr & AttrRHSA(a, 1)
End If
Next a
SelFileInfo.Rname = UCase(RightFhj(Filename)) '后缀名
Fsize = F.Size: DoEvents
SelFileInfo.Size = Fsize
SelFileInfo.DateCreated = F.DateCreated '建立时间
SelFileInfo.DateLastAcce = F.DateLastAccessed '最后一次存取日期
SelFileInfo.DateLastModified = F.DateLastModified '最后一次修改时间

SelFileInfo.Attr = FdAttr
End Function

Public Function ShowFolderInfo(FolderPath As String) '取目录信息
Dim Fs As New FileSystemObject
Dim Fd As Folder
Dim RetuAttr As Long
Dim FdAttr As String
Dim a As Long
Dim Fsize As Long

If Len(FolderPath) = 0 Then Exit Function
Set Fd = Fs.GetFolder(FolderPath)
If Fd.IsRootFolder Then '根目录
SelFoldInfo.Size = "" '大小
SelFoldInfo.DateCreated = "" '建立时间
SelFoldInfo.DateLastAcce = "" '最后一次存取日期
SelFoldInfo.DateLastModified = "" '最后一次修改时间
SelFoldInfo.Attr = "" '属性
Else
Call FAattr
RetuAttr = Fd.Attributes
For a = 0 To 3
If (RetuAttr And CInt(AttrRHSA(a, 0))) <> 0 Then
FdAttr = FdAttr & AttrRHSA(a, 1)
End If
Next a
Fsize = Fd.Size
SelFoldInfo.Size = Fsize
SelFoldInfo.DateCreated = Fd.DateCreated '建立时间
SelFoldInfo.DateLastAcce = Fd.DateLastAccessed '最后一次存取日期
SelFoldInfo.DateLastModified = Fd.DateLastModified '最后一次修改时间
SelFoldInfo.Attr = FdAttr '属性
End If
End Function

Public Sub FAattr() 'RHSA属性
AttrRHSA(0, 0) = 1: AttrRHSA(0, 1) = "R"
AttrRHSA(1, 0) = 2: AttrRHSA(1, 1) = "H"
AttrRHSA(2, 0) = 32: AttrRHSA(2, 1) = "A"
AttrRHSA(3, 0) = 4: AttrRHSA(3, 1) = "S"
End Sub

[rainstormmaster]

可用api函数GetFileTime获得文件的创建时间

【VB声明】
Private Declare Function GetFileTime Lib "kernel32" Alias "GetFileTime" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long

【说明】
取得指定文件的时间信息

【返回值】
Long，非零表示成功，零表示失败。会设置GetLastError

【备注】
如果不需要特定的信息，那么lpCreationTime，lpLastAccessTime，lpLastWriteTime都可以设置为零（用ByVal
As Long）。这个函数返回的文件时间采用UTC格式

【参数表】
hFile ---------- Long，文件的句柄

lpCreationTime - FILETIME，用于装载文件的创建时间

lpLastAccessTime - FILETIME，用于装载文件上一次访问的时间（FAT文件系统不支持这一特性）

lpLastWriteTime - FILETIME，用于装载文件上一次修改的时间


该函数的例子：
'This program needs a Dialog box, named CDBox1
' (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 SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
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 Const FO_DELETE = &H3
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh 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 MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, 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 SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [e-mail]
Dim lngHandle As Long, SHDirOp As SHFILEOPSTRUCT, lngLong As Long
Dim Ft1 As FILETIME, Ft2 As FILETIME, SysTime As SYSTEMTIME
'Set the dialog's title
CDBox.DialogTitle = "Choose a file ..."
'Raise an error when the user pressed cancel
CDBox.CancelError = True
'Show the 'Open File'-dialog
CDBox.ShowOpen
'Create a new directory
CreateDirectory "C:\KPD-Team", ByVal &H0
'Copy the selected file to our new directory
CopyFile CDBox.filename, "C:\KPD-Team\" + CDBox.FileTitle, 0
'Rename the file
MoveFile "C:\KPD-Team\" + CDBox.FileTitle, "C:\KPD-Team\test.kpd"
'Open the file
lngHandle = CreateFile("C:\KPD-Team\test.kpd", GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
'Get the file's size
MsgBox "The size of the selected file is" + Str$(GetFileSize(lngHandle, lngLong)) + " bytes."
'Get the fil's time
GetFileTime lngHandle, Ft1, Ft1, Ft2
'Convert the file time to the local file time
FileTimeToLocalFileTime Ft2, Ft1
'Convert the file time to system file time
FileTimeToSystemTime Ft1, SysTime
MsgBox "The selected file was created on" + Str$(SysTime.wMonth) + "/" + Ltrim(Str$(SysTime.wDay)) + "/" + Ltrim(Str$(SysTime.wYear))
'Close the file
CloseHandle lngHandle
'Delete the file
DeleteFile "C:\KPD-Team\test.kpd"
With SHDirOp
.wFunc = FO_DELETE
.pFrom = "C:\KPD-Team"
End With
'Delete the directory
SHFileOperation SHDirOp
End
End Sub

[啊维]

真详细.................快学ing

[pigpag]

用FSO比较简单，但增加了程序发布的负担

[quanquan626]

学习