'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:[email protected]
'
'
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
File Time Date Stamps
- Introduction
- Setting Time Date Stamp
- Touch Module
Touch Module
You might also like...
VB 6 books
-
Programming with Microsoft Visual Basic 2008
Programming with Microsoft Visual Basic 2008, Fourth Edition by the best-selling author, Diane Zak, is designed for a first course in programming. Using the most recent version of the software, Visual Basic 2008, this book teaches individuals how to ...
VB 6 forum discussion
-
CorelDRAW VBA: cdrTraceLineDrawing FAILS, producing single linear path instead of Centerline trace?
by dancemanj (0 replies)
-
client/server application using activex
by beautifulheart (0 replies)
-
System Error &H8007007E. The specifed module could not be found.
by swiftsafe (5 replies)
-
Invitation to take part in an academic research study
by researchlab (0 replies)
-
Send SMS with SMPP
by mmahmoud (0 replies)
VB 6 podcasts
-
Stack Overflow Podcast: Podcast #45 – Keeping it Sharp
Published 7 years ago, running time 0h54m
Our guest this week is Eric Lippert – language architect extraordinaire and famous for all his work at Microsoft in developing their languages Eric joined Microsoft right out of college and was originally working on VB It’s time for everyone’s favorite game: Name the Worst Feature of that Microso.
Comments