' ----------------------------------------------------------------------------
' FUNCTIONI ChangeFileDateAndTime As Integer  DECEMBER 2001      by J.Philippe
'
'                    CHANGE  DATE(s)  and  TIME(s)  of  a  FILE
' INCLUDE FILE
' ----------------------------------------------------------------------------
'
' $INCLUDE "ChangeFileDateAndTime.Inc"
'
' EXAMPLE 
' -------
'    ChangeFileDateAndTime (pathFileName$, Year%, month%, day%, _
'                                       hour%, minute%, second%, optionWhichTimes$)
'
'    i = ChangeFileDateAndTime ("c:\myDir\myFile", 1983, 6, 21, 17, 22, 33)
'                 the LastWriteTime Of MyFile is set to June 21 st 1983 at 17:22:23
'
'    Return  0 (False) on Failure or 1 (True) on success
'
' ----- CODE OF FUNCTIONI ----------------------------------------------------
'
$ESCAPECHARS ON
$TYPECHECK ON
'
' cft for Change_File_Time and to prevent double declaration of type ...
'
Type T_FILETIMEcft
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
'
Type T_SYSTEMTIMEcft
    wYear As Short  ' VB INTEGER ARE RQ SHORT
    wMonth As Short
    wDayOfWeek As Short
    wDay As Short
    wHour As Short
    wMinute As Short
    wSecond As Short
    wMilliseconds As Short
End Type
'
Const GENERIC_WRITE = &H40000000
Const OPEN_EXISTING = 3
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
'
Declare Function SetFileTime Lib "kernel32" Alias "SetFileTime" (ByVal hFile As Long, _
                    lpCreationTime As T_FILETIMEcft, lpLastAccessTime As T_FILETIMEcft, _
                    lpLastWriteTime As T_FILETIMEcft) As Long
Declare Function SystemTimeToFileTime Lib "kernel32" Alias "SystemTimeToFileTime" _
                    (lpSystemTime As T_SYSTEMTIMEcft, lpFileTime As T_FILETIMEcft) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByRef 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
Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long
'
Declare Functioni ChangeFileDateAndTime ( ... ) As Long
' "PathFileName", YYYY, MM, DD, hh, mm, ss, "CREATION andor WRITE andor ACCESS"
'
Functioni ChangeFileDateAndTime ( ... ) As Long
    DefInt iHandle, N
    DefInt dateTime(1 To 6) = {1985, 8, 23, 22, 10, 12} ' YYYY, MM, DD, hh, mm, ss (08/23/1985 22:10:12)
    DefStr pathFileName, whichTimes, cftErr
    Dim bufferFileTime As T_FILETIMEcft
    Dim systemTime as T_SYSTEMTIMEcft
    ' Get String Parameters of the Functioni
    ' ---------------------------------
    cftErr = ""
    If ParamStrCount > 0 Then
        pathFileName = ParamStr$(1)
    Else
        cftErr = "No FileName Provided"
    End If    
    If cftErr <> "" Then Goto cftError
    If ParamStrCount > 1 Then whichTimes = ParamStr$(2)  ' Optional
'
    ' Open The File
    ' -------------
    iHandle = CreateFile(pathFileName, GENERIC_WRITE, (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
                        0, OPEN_EXISTING, 0, 0)
    If iHandle = 0 Then cftErr = "File Not Found":Goto cftError
'
    ' Get Numeric Parameters of the Functioni
    ' ---------------------------------------
    cftErr = ""
    For N = 1 To 6
       If ParamValCount > N - 1 Then
            dateTime(N) = ParamVal(N)
        Else
            cftErr = Str$(N - 1) & " Numeric Param(s) Recieved, 6 Awaited"
            Exit For
        End If
    Next N
    If cftErr <> "" Then Goto cftError
'
    With systemTime
        .wYear = dateTime(1)
        .wMonth = dateTime(2)
'        .wDayOfWeek = 0
        .wDay = dateTime(3)
        .wHour = dateTime(4)
        .wMinute = dateTime(5)
        .wSecond = dateTime(6)
        .wMilliseconds = 333       
    End with
'
    ' set The New File Time On Disk
    ' -----------------------------
    SystemTimeToFileTime (systemTime, bufferFileTime)
    If Instr(Ucase$(whichTimes), "CRE") Then
        If SetFileTime (iHandle, bufferFileTime, 0, 0) <> 1 Then cftErr = "Problem in Writing CreationTime"
    End If    
    If cftErr <> "" Then Goto cftError
    
    If Instr(Ucase$(whichTimes), "ACC") Then
        If SetFileTime (iHandle, 0, bufferFileTime, 0) <> 1 Then cftErr = "Problem in Writing lastAccessTime"
    End If
    If cftErr <> "" Then Goto cftError

    If (Instr(Ucase$(whichTimes), "WRI") or whichTimes = "") Then
        If SetFileTime (iHandle, 0, 0, bufferFileTime) <> 1 Then cftErr = "Problem in Writing lastWriteTime"
    End If
    If cftErr <> "" Then Goto cftError

    If iHandle Then CloseHandle iHandle
    Result = 1 ' True
    Exit Functioni
cftError:
    Result = 0 ' False
    If iHandle Then CloseHandle iHandle
    ShowMessage ("While Changing File Date and/or Time : \n" & "    " & cftErr)
End Functioni
'
$ESCAPECHARS OFF
$TYPECHECK OFF
'
' ------ END OF FUNCTIONI ----------------------------------------------------
'