by Chong Long Choo (4 Submissions)
Category: Files/File Controls/Input/Output
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 9th October 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Obtaining Information Of A File
API Declarations
' Name: Obtaining Information Of A File
' Author: Chong Long Choo
' Email: [email protected]
' Date: 09 September 1999
'<--------------------------Disclaimer------------------------------->
'
'This sample is free. You can use the sample in any form. Use this
'sample at your own risk! I have no warranty for this sample.
'
'<--------------------------Disclaimer------------------------------->
'---------------------------------------------------------------------------------
'How to use
'---------------------------------------------------------------------------------
' Dim lngDBQ as Long
' Dim objFileProp As clsFileProp
' Set objFileProp = New clsFileProp
' With objFileProp
' lngDBQ = .FindFileInfo("c:\autoexec.bat")
' If lngDBQ = 1 Then
' Debug.Print .FileName
' Debug.Print Format(.mByte, "#,###,###") & " Bait"
' Debug.Print .CreationTime
' Debug.Print .LastAccessTime
' Debug.Print .LastWriteTime
' Debug.Print .ReadOnly
' Debug.Print .Hidden
' Debug.Print .Archive
' End If
' End With
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Type FILETIME
LowDateTime As Long
HighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260 'MUST be set to 260
cAlternate As String * 14
End Type
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
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
Private mvarCompanyName As String
Private mvarFileDescription As String
Private mvarFileVersion As String
Private mvarInternalName As String
Private mvarLegalCopyright As String
Private mvarOriginalFileName As String
Private mvarProductName As String
Private mvarProductVersion As String
Private mvarFileName As String
Private mvarByte As String
Private mvarCreationTime As String
Private mvarLastAccessTime As String
Private mvarLastWriteTime As String
Private mvarReadOnly As Boolean
Private mvarHidden As Boolean
Private mvarSystem As Boolean
Private mvarDirectory As Boolean
Private mvarArchive As Boolean
Private mvarNormal As Boolean
Private mvarTemporary As Boolean
Private mvarCompress As Boolean
VBcoders
Compress = mvarCompress
End Property
Public Property Get Temporary() As Boolean
Temporary = mvarTemporary
End Property
Public Property Get Normal() As Boolean
Normal = mvarNormal
End Property
Public Property Get Archive() As Boolean
Archive = mvarArchive
End Property
Public Property Get Directory() As Boolean
Directory = mvarDirectory
End Property
Public Property Get System() As Boolean
System = mvarSystem
End Property
Public Property Get Hidden() As Boolean
Hidden = mvarHidden
End Property
Public Property Get ReadOnly() As Boolean
ReadOnly = mvarReadOnly
End Property
Public Property Get LastWriteTime() As String
LastWriteTime = mvarLastWriteTime
End Property
Public Property Get LastAccessTime() As String
LastAccessTime = mvarLastAccessTime
End Property
Public Property Get CreationTime() As String
CreationTime = mvarCreationTime
End Property
Public Property Get mByte() As String
mByte = mvarByte
End Property
Public Property Get ProductVersion() As String
ProductVersion = mvarProductVersion
End Property
Public Property Get ProductName() As String
ProductName = mvarProductName
End Property
Public Property Get OriginalFileName() As String
OriginalFileName = mvarOriginalFileName
End Property
Public Property Get LegalCopyright() As String
LegalCopyright = mvarLegalCopyright
End Property
Public Property Get InternalName() As String
InternalName = mvarInternalName
End Property
Public Property Get FileVersion() As String
FileVersion = mvarFileVersion
End Property
Public Property Get FileDescription() As String
FileDescription = mvarFileDescription
End Property
Public Property Get CompanyName() As String
CompanyName = mvarCompanyName
End Property
Public Property Get FileName() As String
FileName = mvarFileName
End Property
Public Function FindFileInfo(strFileName As String) As Long
On Error GoTo GetFileVersionData_Error
Dim sInfo As String, lSizeof As Long
Dim lResult As Long, iDelim As Integer, n As Integer, lHandle As Long
Dim ftime As SYSTEMTIME
Dim filedata As WIN32_FIND_DATA
If strFileName <> "" Then
filedata = Findfile(strFileName)
Call FileTimeToSystemTime(filedata.ftCreationTime, ftime)
mvarCreationTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filedata.ftLastWriteTime, ftime) ' Determine Last Modified date and time
mvarLastWriteTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
Call FileTimeToSystemTime(filedata.ftLastAccessTime, ftime) ' Determine Last accessed date (note no time is recorded)
mvarLastAccessTime = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear
mvarHidden = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN)
mvarSystem = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM)
mvarReadOnly = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY)
mvarArchive = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE)
mvarTemporary = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY)
mvarNormal = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL)
mvarCompress = ((filedata.dwFileAttributes And FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED)
mvarFileName = UCase$(strFileName)
If filedata.nFileSizeHigh = 0 Then ' Put size into text box
mvarByte = Format$(filedata.nFileSizeLow, "###,###,###") & " bytes"
Else
mvarByte = Format$(filedata.nFileSizeHigh, "###,###,###") & " bytes"
End If
lHandle = 0
lSizeof = GetFileVersionInfoSize(strFileName, lHandle)
If lSizeof > 0 Then
sInfo = String$(lSizeof, 0)
lResult = GetFileVersionInfo(ByVal strFileName, 0&, ByVal lSizeof, ByVal sInfo)
If lResult Then
iDelim = InStr(sInfo, "CompanyName")
If iDelim > 0 Then
iDelim = iDelim + 12
mvarCompanyName = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "FileDescription")
If iDelim > 0 Then
iDelim = iDelim + 16
mvarFileDescription = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "FileVersion")
If iDelim > 0 Then
iDelim = iDelim + 12
mvarFileVersion = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "InternalName")
If iDelim > 0 Then
iDelim = iDelim + 16
mvarInternalName = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "LegalCopyright")
If iDelim > 0 Then
iDelim = iDelim + 16
mvarLegalCopyright = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "OriginalFilename")
If iDelim > 0 Then
iDelim = iDelim + 20
mvarOriginalFileName = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "ProductName")
If iDelim > 0 Then
iDelim = iDelim + 12
mvarProductName = Mid$(sInfo, iDelim)
End If
iDelim = InStr(sInfo, "ProductVersion")
If iDelim > 0 Then
iDelim = iDelim + 16
mvarProductVersion = Mid$(sInfo, iDelim)
End If
FindFileInfo = 1
Else
GoTo invalid_file_info_error
End If
Else
GoTo invalid_file_info_error
End If
Else
FindFileInfo = 0
End If
GetFileVersionData_Exit:
Exit Function
GetFileVersionData_Error:
FindFileInfo = 0
Resume GetFileVersionData_Exit
invalid_file_info_error:
FindFileInfo = 1
GoTo GetFileVersionData_Exit
End Function
Private Function Findfile(xstrfilename) As WIN32_FIND_DATA
Dim Win32Data As WIN32_FIND_DATA
Dim plngFirstFileHwnd As Long
Dim plngRtn As Long
plngFirstFileHwnd = FindFirstFile(xstrfilename, Win32Data) ' Get information of file using API call
If plngFirstFileHwnd = 0 Then
Findfile.cFileName = "Error" ' If file was not found, return error as name
Else
Findfile = Win32Data ' Else return results
End If
plngRtn = FindClose(plngFirstFileHwnd) ' It is important that you close the handle for FindFirstFile
End Function