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

Question

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

Answer 1

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

Answer 2

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

Answer 3

关于FSO的一些操作.'工程==>引用==>Microsoft Scripting RuntimeOption ExplicitPrivate 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 TypePublic 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

Answer 4

'*******************************************************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 FunctionFunction 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 FunctionPublic 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 FunctionPublic 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 FunctionPublic 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

Answer 5

可用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: [email protected]
    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

Answer 6

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