Login | Register   
RSS Feed
Download our iPhone app
Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB4/32, VB5, VB6
Expertise: Advanced
Nov 14, 2003



How to Boost Database Development Productivity on Linux, Docker, and Kubernetes with Microsoft SQL Server 2017

Override Built-in Keywords

You can override some of the built-in VB keywords with your own version of the function. For instance, FileDateTime is a handy built-in function in VB, but it suffers from one big problem: It cant set the date/time of a file. By overriding the built-in function, however, you can provide this feature. With this approach, the function can determine for itself how it is being used and perform accordingly.

You can override a number of keywords and functions in this manner:

Private Declare Function SystemTimeToFileTime Lib _
	"kernel32" (lpSystemTime As SYSTEMTIME, _
	lpFileTime As FILETIME) As Long
Private Declare Function LocalFileTimeToFileTime _
	Lib "kernel32" (lpLocalFileTime As FILETIME, _
	lpFileTime As FILETIME) 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 SetFileTime Lib "kernel32" _
	(ByVal hFile As Long, lpCreationTime As Any, _
	lpLastAccessTime As Any, lpLastWriteTime As _
	Any) As Long
Private Declare Function CloseHandle Lib "kernel32" _
	(ByVal hObject As Long) As Long

Private Type FILETIME
	dwLowDateTime As Long
	dwHighDateTime As Long
End Type

	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 Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING As Long = 3

Public Function FileDateTime(ByVal FileName As String, _
	Optional ByVal TimeStamp As Variant) As Date

	' Raises an error if one occurs just like FileDateTime

	Dim x As Long
	Dim Handle As Long
	Dim System_Time As SYSTEMTIME
	Dim File_Time As FILETIME
	Dim Local_Time As FILETIME

	If IsMissing(TimeStamp) Then
		'It's missing so they must want to GET the timestamp
		'This acts EXACTLY like the original built-in function
		FileDateTime = VBA.FileDateTime(FileName)
	ElseIf VarType(TimeStamp) <> vbDate Then
		'You must pass in a date to be valid
		Err.Raise 450
		System_Time.wYear = Year(TimeStamp)
		System_Time.wMonth = Month(TimeStamp)
		System_Time.wDay = Day(TimeStamp)
		System_Time.wDayOfWeek = _
			Weekday(TimeStamp) - 1
		System_Time.wHour = Hour(TimeStamp)
		System_Time.wMinute = Minute(TimeStamp)
		System_Time.wSecond = Second(TimeStamp)
		System_Time.wMilliseconds = 0

		'Convert the system time to a file time
		x = SystemTimeToFileTime(System_Time, Local_Time)

		'Convert local file time to file time based on UTC
		x = LocalFileTimeToFileTime(Local_Time, File_Time)

		'Open the file so we can get a file handle to 
		'the file
		Handle = CreateFile(FileName, GENERIC_WRITE, _
			ByVal 0&, OPEN_EXISTING, 0, 0)
		If Handle = 0 Then
			Err.Raise 53, "FileDateTime", _
				"Can't open the file"
			'Now change the file time and date stamp
			x = SetFileTime(Handle, ByVal 0&, _
				ByVal 0&, File_Time)
			If x = 0 Then
				'Error occured
				Err.Raise 1, "FileDateTime", _
					"Unable to set file timestamp"
			End If
			Call CloseHandle(Handle)
			'Return newly set date/time
			FileDateTime = VBA.FileDateTime(FileName)
		End If
	End If
End Function
Darin Higgins
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date