'Touch.bas - VB code to set a file's date and time safely
'
'        Courtesy of VDEV.NET - developers of Windows and Internet software
'        Want to find out more?  mailto:chris@vdev.net
'
'


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

'Made private to prevent namespace pollution

Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1

Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) 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 CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile 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 SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Public Function Touch(ByVal sFileName As String, ByVal dDate As Date) As Boolean
Dim hFile As Long
Dim iResult As Long

Dim lpCreationTime As FILETIME
Dim lpLastAccessTime As FILETIME
Dim lpLastWriteTime As FILETIME
Dim lpLocalFileTime As FILETIME
Dim lpSystemTime As SYSTEMTIME

    hFile = CreateFile(sFileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
    If hFile <> INVALID_HANDLE_VALUE Then
        With lpSystemTime
            .wDay = Day(dDate)
            .wMonth = Month(dDate)
            .wYear = Year(dDate)
            .wHour = Hour(dDate)
            .wMinute = Minute(dDate)
            .wSecond = Second(dDate)
        End With
        iResult = SystemTimeToFileTime(lpSystemTime, lpLocalFileTime)
        If iResult Then
            iResult = GetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime)
            If iResult Then
                iResult = LocalFileTimeToFileTime(lpLocalFileTime, lpLastWriteTime)
                If iResult Then
                    iResult = SetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime)
                    Touch = CBool(iResult)
                Else
                    Touch = False
                End If
            Else
               Touch = False
            End If
        Else
            Touch = False
        End If
        CloseHandle hFile
    Else
       Touch = False
    End If
End Function