Attribute VB_Name = "modFileDTStamps"
Option Explicit

Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400

Private Type SHELLEXECUTEINFO
    cbSize        As Long
    fMask         As Long
    hWnd          As Long
    lpVerb        As String
    lpFile        As String
    lpParameters  As String
    lpDirectory   As String
    nShow         As Long
    hInstApp      As Long
    lpIDList      As Long
    lpClass       As String
    hkeyClass     As Long
    dwHotKey      As Long
    hIcon         As Long
    hProcess      As Long
End Type

'system commands
Private Declare Function ShellExecuteEx Lib "shell32" (SEI As SHELLEXECUTEINFO) As Long

Private Const MAX_PATH = 260

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

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF

Private Function GetFileDateTimeString(CT As FILETIME) As String
    Dim ST As SYSTEMTIME
    Dim ds As Single
    Dim ts As Single
    'convert the passed FILETIME to a
    'valid SYSTEMTIME format for display
    If FileTimeToSystemTime(CT, ST) Then
        ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
        ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
        GetFileDateTimeString = Format$(ds, "MMMM DD, YYYY") & Format$(ts, " HH:NN:SS AMPM")
    Else
        GetFileDateTimeString = ""
    End If
End Function

Private Function GetFileSysStyleDateTimeString(CT As FILETIME) As String
    Dim ST As SYSTEMTIME
    Dim ds As Single
    Dim ts As Single
    'convert the passed FILETIME to a
    'valid SYSTEMTIME format for display
    If FileTimeToSystemTime(CT, ST) Then
        ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
        ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
        GetFileSysStyleDateTimeString = Format$(ds, "DDDD, MMMM DD, YYYY") & Format$(ts, " HH:NN:SS AMPM")
    Else
        GetFileSysStyleDateTimeString = ""
    End If
End Function


Private Sub ApiRaise(ByVal e As Long)
    Err.Raise vbObjectError + 29000 + e, _
              App.EXEName & ".Windows", ApiError(e)
End Sub

Private Function ApiError(ByVal e As Long) As String
    Dim s As String, c As Long
    s = String(256, 0)
    c = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                      FORMAT_MESSAGE_IGNORE_INSERTS, _
                      0, e, 0&, s, Len(s), ByVal 0)
    If c Then ApiError = Left$(s, c)
End Function

'###################################################################################
'# Function Name    :   FileDTStamps
'# Desc             :   Returns the file Created, Modified, & Accessed DTStamps in local system time
'#
'#                      strFilePath  = Valid System File Path
'#                      datCreation = File Creation DateTimeStamp
'#                      datModified = File Modified DateTimeStamp
'#                      datAccess = File Access DateTimeStamp
'#                      strError = Error Description if the function fails
'#
'# Example Use      :
'# '''    Dim datModified As String, datCreated As String, datAccessed As String, strError As String
'# '''    Dim bRes As Boolean
'# '''    bRes = FileDTStamps(Text1, datCreated, datModified, datAccessed, strError)
'# '''    If bRes Then
'# '''        tmp = "Created: " & datCreated & vbCrLf
'# '''        tmp = tmp & "Last modified: " & datModified & vbCrLf
'# '''        Text2 = tmp & "Last accessed: " & datAccessed & vbCrLf
'# '''    Else
'# '''        Text2 = strError
'# '''    End If
'#
'# Returns          :   TRUE if the file DTStamps were returned
'#                      FALSE if an error occured. See strError for the Error Description.
'#
'###################################################################################
Public Function FileDTStamps(strFilePath As String, _
                         datCreation As String, _
                         datModified As String, _
                         datAccess As String, strError As String) As Boolean
    Dim fnd As WIN32_FIND_DATA  'file info from filefind
    Dim hFind As Long           'file handle for valid file test
    FileDTStamps = False     'set return value to false for error return
    On Error Resume Next        'recover and return after error
    hFind = FindFirstFile(strFilePath, fnd) 'grab the file info
    If hFind = INVALID_HANDLE_VALUE Then                'test if the file is valid
        ApiRaise Err.LastDllError           'get error info if error
        strError = Err.Description
        Exit Function
    End If
    FindClose hFind                     ' close the filehandle
    Dim lftCreationTime As FILETIME     ' Convert gmt times to local times
    Dim lftLastAccessTime As FILETIME
    Dim lftLastWriteTime As FILETIME
    Call FileTimeToLocalFileTime(fnd.ftCreationTime, lftCreationTime)
    Call FileTimeToLocalFileTime(fnd.ftLastAccessTime, lftLastAccessTime)
    Call FileTimeToLocalFileTime(fnd.ftLastWriteTime, lftLastWriteTime)
    datCreation = GetFileDateTimeString(lftCreationTime)    'return the values
    datAccess = GetFileDateTimeString(lftLastAccessTime)
    datModified = GetFileDateTimeString(lftLastWriteTime)
    FileDTStamps = True
End Function

'###################################################################################
'# Function Name    :   DisplaySystemInfoDialog
'# Desc             :   Displays the system information dialog for an object given a valid path
'#
'#                      strFilePath  = Valid System Path
'#                      hWnd = The window handle of the calling window
'#
'# Example Use      :
'#          DisplaySystemInfoDialog ValidSystemPath, Me.hWnd
'#
'# Returns          :   nothing
'###################################################################################
Public Sub DisplaySystemInfoDialog(strFilePath As String, hWnd As Long)
    Dim SEI As SHELLEXECUTEINFO
    With SEI                    'Fill in the SHELLEXECUTEINFO structure
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or _
                 SEE_MASK_INVOKEIDLIST Or _
                 SEE_MASK_FLAG_NO_UI
        .hWnd = hWnd
        .lpVerb = "properties"
        .lpFile = (strFilePath)
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With
    Call ShellExecuteEx(SEI)    'call the ShellExecuteEx API
End Sub