Hi again.
This is the full code which you need:
Copy and paste this into a new form, with a textbox called "Text1" and a
command button called Command1. You can change these names, but then the code
must also be changed.
Once you have done this, put the path of the file you want to check into the
textbox and click the button.
Donnot worry about the functions, all you need to worry about is the last 2
public functions (Form_Load, and Command1_Click). Here you can change the
code to fit your needs accordingly.
Cheers.
-State
Option Explicit
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA"
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode
As Long, ByVal NoSecurity As Long, ByVal dwCreationDisposition As Long, ByVal
dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime
As FILETIME, lpLocalFileTime As FILETIME) As Long
' Convert the FILETIME structure into a Date.
Private Function FileTimeToDate(ft As FILETIME) As Date
' FILETIME units are 100s of nanoseconds.
Const TICKS_PER_SECOND = 10000000
Dim lo_time As Double
Dim hi_time As Double
Dim seconds As Double
Dim hours As Double
Dim the_date As Date
' Get the low order data.
If ft.dwLowDateTime < 0 Then
lo_time = 2 ^ 31 + (ft.dwLowDateTime And &H7FFFFFFF)
Else
lo_time = ft.dwLowDateTime
End If
' Get the high order data.
If ft.dwHighDateTime < 0 Then
hi_time = 2 ^ 31 + (ft.dwHighDateTime And &H7FFFFFFF)
Else
hi_time = ft.dwHighDateTime
End If
' Combine them and turn the result into hours.
seconds = (lo_time + 2 ^ 32 * hi_time) / TICKS_PER_SECOND
hours = CLng(seconds / 3600)
seconds = seconds - hours * 3600
' Make the date.
the_date = DateAdd("h", hours, "1/1/1601 0:00 AM")
the_date = DateAdd("s", seconds, the_date)
FileTimeToDate = the_date
End Function
' Return True if there is an error.
Private Function GetFileTimes(ByVal file_name As String, ByRef date_created
As Date, ByRef date_accessed As Date, ByRef date_written As Date, ByVal
local_time As Boolean) As Boolean
Dim file_handle As Long
Dim creation_time As FILETIME
Dim access_time As FILETIME
Dim write_time As FILETIME
Dim file_time As FILETIME
' Open the file.
file_handle = CreateFile(file_name, GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
0&, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then
GetFileTimes = True
Exit Function
End If
' Get the times.
If GetFileTime(file_handle, creation_time, _
access_time, write_time) = 0 _
Then
GetFileTimes = True
Exit Function
End If
' Close the file.
If CloseHandle(file_handle) = 0 Then
GetFileTimes = True
Exit Function
End If
' See if we should convert to the local
' file system time.
If local_time Then
' Convert to local file system time.
FileTimeToLocalFileTime creation_time, file_time
creation_time = file_time
FileTimeToLocalFileTime access_time, file_time
access_time = file_time
FileTimeToLocalFileTime write_time, file_time
write_time = file_time
End If
' Convert into dates.
date_created = FileTimeToDate(creation_time)
date_accessed = FileTimeToDate(access_time)
date_written = FileTimeToDate(write_time)
End Function
Private Sub Command1_Click()
Dim date_created As Date
Dim date_accessed As Date
Dim date_written As Date
Dim txt As String
' UTC times.
If GetFileTimes(Text1.Text, date_created, date_accessed, date_written,
False) Then
txt = "Error getting file times"
Else
txt = "Created: " & Format$(date_created) & vbCrLf & _
"Last Accessed: " & Format$(date_accessed) & vbCrLf & _
"Last Written: " & Format$(date_written)
End If
lblUTC.Caption = txt
' Local file system times.
If GetFileTimes(Text1.Text, date_created, date_accessed, date_written,
True) Then
txt = "Error getting file times"
Else
txt = "Created: " & Format$(date_created) & vbCrLf & _
"Last Accessed: " & Format$(date_accessed) & vbCrLf & _
"Last Written: " & Format$(date_written)
End If
lblFile.Caption = txt
End Sub
Private Sub Form_Load()
Dim file_name As String
file_name = App.Path
If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
file_name = file_name & "Form1.frm"
Text1 = file_name
End Sub
