clsFileDate.cls

 VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFileDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

' ***************************************************************************
' Module:        clsFileDate
'
' Description:   Module with several routines to make use of the
'                File and System date/time stamps.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 25-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ---------------------------------------------------------------------------

' ---------------------------------------------------------------------------
' Constants defined for Date/Time API calls
' ---------------------------------------------------------------------------
  Private Const SEE_MASK_INVOKEIDLIST    As Long = &HC
  Private Const SEE_MASK_NOCLOSEPROCESS  As Long = &H40
  Private Const SEE_MASK_FLAG_NO_UI      As Long = &H400
  Private Const OFS_MAXPATHNAME          As Long = 260
  Private Const OF_READWRITE             As Long = &H2
  Private Const OPEN_EXISTING            As Long = 3
  Private Const FILE_SHARE_READ          As Long = &H1
  Private Const FILE_SHARE_WRITE         As Long = &H2
  Private Const GENERIC_WRITE            As Long = &H40000000
 
' ---------------------------------------------------------------------------
' Types defined for Date/Time API calls
' ---------------------------------------------------------------------------
  Private Type OFSTRUCT
       cBytes          As Byte
       fFixedDisk      As Byte
       nErrCode        As Integer
       Reserved1       As Integer
       Reserved2       As Integer
       szPathName(OFS_MAXPATHNAME) As Byte
  End Type

  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 Long
  End Type

  Private 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

' ---------------------------------------------------------------------------
' Declares defined for Date/Time API calls
' ---------------------------------------------------------------------------
  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 Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
 
  Private Declare Function GetFileTime Lib "kernel32" _
          (ByVal hFile As Long, lpCreationTime As FILETIME, _
          lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) 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 DosDateTimeToFileTime Lib "kernel32" _
          (ByVal wFatDate As Long, ByVal wFatTime As Long, _
          lpFileTime As FILETIME) As Long

  Private Declare Function FileTimeToDosDateTime Lib "kernal32" _
          (lpFileTime As FILETIME, ByVal wFatDate As Long, _
          ByVal wFatTime As Long) As Long
         
  Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
          (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long

  Private Declare Function FileTimeToSystemTime Lib "kernel32" _
          (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
 
  Private Declare Function SystemTimeToFileTime Lib "kernel32" _
          (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
 
  ' get the file handle
  Private Declare Function OpenFile Lib "kernel32" _
          (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, _
          ByVal wStyle As Long) As Long
 
  ' always release the file handle when finished
  Private Declare Function CloseHandle Lib "kernel32" _
          (ByVal hFile As Long) As Long

' ---------------------------------------------------------------------------
' Private Type defined for ShellExecuteEX API call
' ---------------------------------------------------------------------------
  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

' ---------------------------------------------------------------------------
' Declares defined for ShellExecuteEX API call
' ---------------------------------------------------------------------------
  Private Declare Function ShellExecuteEX Lib "shell32.dll" _
          Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

' ---------------------------------------------------------------------------
' Module level variables
' ---------------------------------------------------------------------------
  Private m_typOFStruct      As OFSTRUCT
  Private m_typSystemTime    As SYSTEMTIME
  Private m_typCreateDate    As FILETIME
  Private m_typLastModified  As FILETIME
  Private m_typLastAccessed  As FILETIME
  Private m_typNewModified   As FILETIME
  Private m_typLocalTime     As FILETIME
  Private m_hFile            As Long
  Private m_intAttr          As Integer

Public Function Set_File_Date(ByVal strFilename As String, _
                              Optional ByVal varNewTime As Variant = vbNullString, _
                              Optional blnUseSysTime As Boolean = True) As Boolean

' ***************************************************************************
' Routine:       Set_File_Date
'
' Description:   Change a file's last modified date/time stamp based on
'                either a passed date or the system date and time.  Any date
'                passed is ignored if the boolean switch is TRUE.
'
' Syntax:        Set_File_Date "C:\config.sys","", True
'                Change the Config.sys file date/time to the current date/time
'
' Parameters:    strFilename - Fully qualified path\filename to be updated
'                varNewTime - Send an empty string if using the system date
'                        or a valid date
'                blnUseSysTime - [OPTIONAL] [DEFAULT] True - use current
'                        date/time stamp.
'                        False - Use the date passed
'
' Returns:       True or False
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 25-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRetCode As Long
     
' ---------------------------------------------------------------------------
' see if we are supposed to use the system date/time stamp
' ---------------------------------------------------------------------------
  If blnUseSysTime Then
      ' obtain the local system time into the system time type structure
      ' (adjusts for the GMT deviation of the local time zone)
      Call GetLocalTime(m_typSystemTime)
  Else
      ' Load system time structure with the valid
      ' date that was passed
      With m_typSystemTime
           .wYear = Year(varNewTime)
           .wMonth = Month(varNewTime)
           .wDay = Day(varNewTime)
           .wDayOfWeek = Weekday(varNewTime) - 1
           .wHour = Hour(varNewTime)
           .wMinute = Minute(varNewTime)
           .wSecond = Second(varNewTime)
      End With
  End If
 
' ---------------------------------------------------------------------------
' Transpose the system structure time to the new modifed time
' ---------------------------------------------------------------------------
  lngRetCode = SystemTimeToFileTime(m_typSystemTime, m_typLocalTime)
  lngRetCode = LocalFileTimeToFileTime(m_typLocalTime, m_typNewModified)
 
' ---------------------------------------------------------------------------
' Get file data
' ---------------------------------------------------------------------------
  If Get_FileData(strFilename, True) Then
      ' Update the file's last modified date/time stamp
      lngRetCode = SetFileTime(m_hFile, m_typCreateDate, m_typLastAccessed, m_typNewModified)
 
      ' Set the return flag
      Set_File_Date = CBool(lngRetCode)
   
    ' Release the file
      Call CloseFileHandle(strFilename, True)
  Else
      Set_File_Date = False
  End If
 
End Function

Private Sub CloseFileHandle(strFilename As String, _
                            Optional blnResetingTimestamp As Boolean = False)

' ***************************************************************************
' Routine:       CloseFileHandle
'
' Description:   Close the file handle because we are finished with the file
'                and reset the attributes.
'
' Parameters:    strFilename - Fully qualified path\filename
'                blnResetingTimestamp - [OPTIONAL] [DEFAULT] False - Do not
'                             reset file attributes
'                      True - reset file attributes to zero
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 25-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Always close the file handle
' ---------------------------------------------------------------------------
  Call CloseHandle(m_hFile)
  
' ---------------------------------------------------------------------------
' Reset file attributes if changing file timestamp
' ---------------------------------------------------------------------------
  If blnResetingTimestamp Then
      SetAttr strFilename, m_intAttr
  End If

End Sub

Private Function Get_FileData(strFilename As String, _
                              Optional blnResetingTimestamp As Boolean = False) As Boolean

' ***************************************************************************
' Routine:       Get_FileData
'
' Description:   Get the file date and time stamps and save a copy of the
'                file attributes so they can be reset when finished with the
'                file.
'
' Syntax:        Get_FileData "C:\Config.sys"
'
' Parameters:    strFilename - Fully qualified path\filename
'                blnResetingTimestamp - [OPTIONAL] [DEFAULT] False - Do not
'                             reset file attributes
'                      True - reset file attributes to zero
'
' Returns:       Tue/False
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 25-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

  On Error GoTo Normal_Exit

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRetCode As Long

' ---------------------------------------------------------------------------
' Capture the file's current attributes so they can be reset if the file is
' beint updated.
' ---------------------------------------------------------------------------
  Get_FileData = False
  m_intAttr = GetAttr(strFilename)

' ---------------------------------------------------------------------------
' Reset file attributes to nothing if reseting file timestamp
' ---------------------------------------------------------------------------
  If blnResetingTimestamp Then
      SetAttr strFilename, 0
  End If

' ---------------------------------------------------------------------------
' Capture the file handle
' ---------------------------------------------------------------------------
  m_hFile = OpenFile(strFilename, m_typOFStruct, OF_READWRITE)
  
' ---------------------------------------------------------------------------
' Get the current file date/time stamps
' ---------------------------------------------------------------------------
  lngRetCode = GetFileTime(m_hFile, m_typCreateDate, m_typLastAccessed, m_typLastModified)
 
' ---------------------------------------------------------------------------
' See how we finished.
' ---------------------------------------------------------------------------
  Get_FileData = CBool(lngRetCode)
  Get_FileData = True
 
Normal_Exit:
  On Error GoTo 0   ' nullify this error routine
 
End Function

Public Function Get_SystemDateString(Optional ByVal strDatePattern As String = "m/d/yyyy", _
                                     Optional ByVal strTimePattern As String = "h:mm:ss ampm") As String

' ***************************************************************************
' Routine:       Get_SystemDateString
'
' Description:   Format a date/time string based on the format desired by the
'                user obtained from the current system date/time settings.
'                Defaults to "m/d/yyyy h:mm:ss ampm"
'
' Syntax:        Get_SystemDateString "d-mmm-yyyy", "h:mm"
'
' Parameters:    strDatePattern - [OPTIONAL] Date pattern desired
'                strTimePattern - [OPTIONAL] Time pattern desired
'
' Returns:       Fomatted date/time string
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 25-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim sngDateSerial  As Single
  Dim sngTimeSerial  As Single
 
' ---------------------------------------------------------------------------
' obtain the local system time into the sytem time structure. (adjusts for
' the GMT deviation of the local time zone)
' ---------------------------------------------------------------------------
  Call GetLocalTime(m_typSystemTime)
 
' ---------------------------------------------------------------------------
' Reformat the system time in serial format
' ---------------------------------------------------------------------------
  sngDateSerial = DateSerial(m_typSystemTime.wYear, m_typSystemTime.wMonth, m_typSystemTime.wDay)
  sngTimeSerial = TimeSerial(m_typSystemTime.wHour, m_typSystemTime.wMinute, m_typSystemTime.wSecond)
       
' ---------------------------------------------------------------------------
' Return the completed formatted string
' ---------------------------------------------------------------------------
  Get_SystemDateString = Format$(sngDateSerial, strDatePattern)
  Get_SystemDateString = Get_SystemDateString & " " & Format$(sngTimeSerial, strTimePattern)

End Function

Public Function Get_FileDateString(ByVal strFilename As String, _
                                   Optional ByVal strDatePattern As String = "m/d/yyyy", _
                                   Optional ByVal strTimePattern As String = "h:mm:ss ampm") As String

' ***************************************************************************
' Routine:       Get_FileDateString
'
' Description:   Format a date/time string based on the format desired by the
'                user obtained from the passed filename date/time settings.
'                Defaults to "m/d/yyyy h:mm:ss ampm"
'
' Syntax:        Get_FileDateString "d-mmm-yyyy", "h:mm", "C:\Config.sys"
'
' Parameters:    strFilename - Fully qualified path\filename
'                strDatePattern - [OPTIONAL] Date pattern desired
'                strTimePattern - [OPTIONAL] Time pattern desired
'
' Returns:       Fomatted date/time string
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 25-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRetCode     As Long
  Dim sngDateSerial  As Single
  Dim sngTimeSerial  As Single
 
' ---------------------------------------------------------------------------
' Get file data
' ---------------------------------------------------------------------------
  If Get_FileData(strFilename) Then
 
      ' Transfer file date and time into the sytem time structure.
      ' (adjusts for the GMT deviation of the local time zone)
      lngRetCode = FileTimeToSystemTime(m_typLastModified, m_typSystemTime)
     
      ' if the return value is non-zero then obtain the system date/time in serial format
      If lngRetCode <> 0 Then
          sngDateSerial = DateSerial(m_typSystemTime.wYear, m_typSystemTime.wMonth, m_typSystemTime.wDay)
          sngTimeSerial = TimeSerial(m_typSystemTime.wHour, m_typSystemTime.wMinute, m_typSystemTime.wSecond)
     
          'format the output string
          Get_FileDateString = Format$(sngDateSerial, strDatePattern)
          Get_FileDateString = Get_FileDateString & " " & Format$(sngTimeSerial, strTimePattern)
      Else
          Get_FileDateString = ""
      End If
 
      ' We got our date data, now close the file handle
      Call CloseFileHandle(strFilename)
  Else
      Get_FileDateString = ""
  End If
 
End Function

Project Homepage: