VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cFileInfo" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cFileInfo Class Module ' ---------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : April 01, 2000 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : NOTHING ' ' Description : This class module was created to easily get any file's information with as little work on ' the programmer's part as is possible. This class module will also let you easily change the ' file attributes of any file... even hidden and system files. VB does not let you change ' attributes on hidden or system files unless you use the Windows API. ' ' Example Use : ' ' Dim File As cFileInfo ' Set File = New cFileInfo ' File.FilePath = "C:\Autoexec.bat" ' Me.Caption = " C:\Autoexec.bat" ' Me.Icon = LoadPicture() ' Me.AutoRedraw = True ' File.GetFileIcon Me.hDC, 6, 3, File.fIconH ' Me.Print vbCrLf & vbCrLf & vbCrLf & _ ' " File Size = " & File.fSize & vbCrLf & _ ' " File Created = " & File.fDateCreated & vbCrLf & _ ' " File Created = " & File.fDateAccessed & vbCrLf & _ ' " File Created = " & File.fDateModified & vbCrLf & _ ' " File Type = " & File.fType & vbCrLf & _ ' " Target OS = " & File.fTargetOS ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' CONSTANTS Private Const Mon As String = "MONDAY" Private Const Tue As String = "TUESDAY" Private Const Wed As String = "WEDNESDAY" Private Const Thr As String = "THURSDAY" Private Const Fri As String = "FRIDAY" Private Const Sat As String = "SATURDAY" Private Const Sun As String = "SUNDAY" Private Const Jan As String = "JANUARY" Private Const Feb As String = "FEBRUARY" Private Const Mar As String = "MARCH" Private Const Apr As String = "APRIL" Private Const May As String = "MAY" Private Const Jun As String = "JUNE" Private Const Jul As String = "JULY" Private Const Aug As String = "AUGUST" Private Const Sep As String = "SEPTEMBER" Private Const Ocr As String = "OCTOBER" Private Const Nov As String = "NOVEMBER" Private Const Dec As String = "DECEMBER" Private Const MAX_PATH = 260 Private Const INVALID_HANDLE_VALUE = -1 Private Const SHGFI_ICON = &H100 Private Const SHGFI_DISPLAYNAME = &H200 Private Const SHGFI_TYPENAME = &H400 Private Const FILE_ATTRIBUTE_ARCHIVE = &H20 Private Const FILE_ATTRIBUTE_COMPRESSED = &H800 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Const FILE_ATTRIBUTE_HIDDEN = &H2 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_ATTRIBUTE_READONLY = &H1 Private Const FILE_ATTRIBUTE_SYSTEM = &H4 Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 Private Const VOS_DOS = &H10000 ' MS-DOS Private Const VOS_DOS_WINDOWS16 = &H10001 ' 16bit Windows on DOS (Windows 3.0, 3.1x) Private Const VOS_DOS_WINDOWS32 = &H10004 ' 32bit Windows on DOS (Win32s) Private Const VOS_NT = &H40000 ' Windows NT Private Const VOS_NT_WINDOWS32 = &H40004 ' Win32 API on Windows NT Private Const VOS_OS216 = &H20000 ' 16bit OS/2 Private Const VOS_OS216_PM16 = &H20002 ' 16bit Presentation Manager on 16 bit OS/2 Private Const VOS_OS232 = &H30000 ' 32bit OS/2 Private Const VOS_OS232_PM32 = &H30003 ' 32-bit Presentation Manager on 32 bit OS/2 Private Const VOS_UNKNOWN = &H0& ' Undefined Or unknown ' TYPES / ENUMERATIONS Private Type FILETIME dwLowDateTime As Long dwHighDateTime 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 * MAX_PATH cAlternate As String * 14 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 Private Type SHFILEINFO hIcon As Long ' Icon iIcon As Long ' Icon Index dwAttributes As Long ' SFGAO_ flags szDisplayName As String * MAX_PATH ' Display Name (or path) szTypeName As String * 80 ' Type Name End Type Private Type VS_FIXEDFILEINFO dwSignature As Long dwStrucVersionl As Integer ' e.g. = &h0000 = 0 dwStrucVersionh As Integer ' e.g. = &h0042 = .42 dwFileVersionMSl As Integer ' e.g. = &h0003 = 3 dwFileVersionMSh As Integer ' e.g. = &h0075 = .75 dwFileVersionLSl As Integer ' e.g. = &h0000 = 0 dwFileVersionLSh As Integer ' e.g. = &h0031 = .31 dwProductVersionMSl As Integer ' e.g. = &h0003 = 3 dwProductVersionMSh As Integer ' e.g. = &h0010 = .1 dwProductVersionLSl As Integer ' e.g. = &h0000 = 0 dwProductVersionLSh As Integer ' e.g. = &h0031 = .31 dwFileFlagsMask As Long ' e.g. = &h3F for version "0.42" dwFileFlags As Long ' e.g. VFF_DEBUG Or VFF_PRERELEASE dwFileOS As Long ' e.g. VOS_DOS_WINDOWS16 dwFileType As Long ' e.g. VFT_DRIVER dwFileSubtype As Long ' e.g. VFT2_DRV_KEYBOARD dwFileDateMS As Long ' e.g. 0 dwFileDateLS As Long ' e.g. 0 End Type ' VARIABLES Private FI_ATTRNormal As Boolean Private FI_ATTRReadOnly As Boolean Private FI_ATTRHidden As Boolean Private FI_ATTRSystem As Boolean Private FI_ATTRArchive As Boolean Private FI_ATTRCompressed As Boolean Private FI_ATTRTemporary As Boolean Private FI_Location As String Private FI_Path32bit As String Private FI_Path16bit As String Private FI_Name32bit As String Private FI_Name16bit As String Private FI_Extention As String Private FI_Date_Accessed As String Private FI_Date_Created As String Private FI_Date_Modified As String Private FI_hIcon As Long Private FI_Size As Long Private FI_SizeFormated As String Private FI_SizeCompressed As Long Private FI_SizeCompressedFm As String Private FI_Type As String Private FI_CompanyName As String Private FI_Copyright As String Private FI_Description As String Private FI_InternalName As String Private FI_Language As String Private FI_LegalTrademark As String Private FI_OriginalFileName As String Private FI_ProductName As String Private FI_ProductVersion As String Private FI_TargetOS As String Private FI_Version As String Private FI_Version_Major As Integer Private FI_Version_Minor As Integer Private FI_Version_Rev As Single Private Declare Sub CopyMem Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function DrawIcon Lib "USER32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long Private Declare Function DestroyIcon Lib "USER32" (ByVal hIcon As Long) As Long Private Declare Function GetCompressedFileSize Lib "KERNEL32" Alias "GetCompressedFileSizeA" (ByVal lpFileName As String, lpFileSizeHigh 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 GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long Private Declare Function GetShortPathName Lib "KERNEL32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer 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 Declare Function FileTimeToLocalFileTime Lib "KERNEL32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long Private Declare Function FileTimeToSystemTime Lib "KERNEL32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long Private Declare Function SHGetFileInfo Lib "SHELL32.DLL" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) 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 lstrlenA Lib "KERNEL32" (ByVal LPString As Long) As Long Private Declare Function SetFileAttributes Lib "KERNEL32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long '============================================================================================================= ' CLASS PROPERTIES '============================================================================================================= ' Return the name of the specified file Public Property Get FilePath() As String FilePath = FI_Path32bit End Property ' Set the name of the specified file and check it's info ' * NOTE : When you set this property, it goes out and retrieves ' all the information about the file and stores it Public Property Let FilePath(ByVal NewValue As String) On Error Resume Next If CheckIfFileExists(NewValue) = False Then MsgBox NewValue & Chr(13) & Chr(13) & "This file does not exist. Can not get it's information.", vbOKOnly + vbExclamation, " File Not Found" Exit Property End If ClearFileInfo FI_Path32bit = NewValue RefreshInfo End Property ' Returns whether or not the ARCHIVE attribute is set for this file Public Property Get fATTR_Archive() As Boolean fATTR_Archive = FI_ATTRArchive End Property ' Sets the ARCHIVE attribute for this file Public Property Let fATTR_Archive(NewValue As Boolean) On Error GoTo ErrorTrap If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_ARCHIVE Else SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL If FI_ATTRCompressed = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_COMPRESSED End If If FI_ATTRHidden = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_HIDDEN End If If FI_ATTRReadOnly = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_READONLY End If If FI_ATTRSystem = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_SYSTEM End If If FI_ATTRTemporary = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_TEMPORARY End If End If FI_ATTRArchive = NewValue FI_ATTRNormal = False Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the ARCHIVE file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns whether or not the COMPRESSED attribute is set for this file Public Property Get fATTR_Compressed() As Boolean fATTR_Compressed = FI_ATTRCompressed End Property ' Sets the COMPRESSED attribute for this file Public Property Let fATTR_Compressed(NewValue As Boolean) On Error GoTo ErrorTrap If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_COMPRESSED Else SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL If FI_ATTRArchive = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_ARCHIVE End If If FI_ATTRHidden = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_HIDDEN End If If FI_ATTRReadOnly = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_READONLY End If If FI_ATTRSystem = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_SYSTEM End If If FI_ATTRTemporary = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_TEMPORARY End If End If FI_ATTRCompressed = NewValue FI_ATTRNormal = False Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the COMPRESSED file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns whether or not the HIDDEN attribute is set for this file Public Property Get fATTR_Hidden() As Boolean fATTR_Hidden = FI_ATTRHidden End Property ' Sets the HIDDEN attribute for this file Public Property Let fATTR_Hidden(NewValue As Boolean) On Error GoTo ErrorTrap If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_HIDDEN Else SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL If FI_ATTRArchive = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_ARCHIVE End If If FI_ATTRCompressed = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_COMPRESSED End If If FI_ATTRReadOnly = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_READONLY End If If FI_ATTRSystem = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_SYSTEM End If If FI_ATTRTemporary = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_TEMPORARY End If End If FI_ATTRHidden = NewValue FI_ATTRNormal = False Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the HIDDEN file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns whether or not the NORMAL attribute is set for this file Public Property Get fATTR_Normal() As Boolean fATTR_Normal = FI_ATTRNormal End Property ' Sets the NORMAL attribute for this file ' * WARNING - BY SETTING THIS ATTRIBUTE, ALL OTHER ATTRIBUTES ARE REMOVED Public Property Let fATTR_Normal(NewValue As Boolean) On Error GoTo ErrorTrap ' If the value is true, all attributes are reset If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL FI_ATTRNormal = True FI_ATTRArchive = False FI_ATTRCompressed = False FI_ATTRHidden = False FI_ATTRReadOnly = False FI_ATTRSystem = False FI_ATTRTemporary = False End If Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the NORMAL file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns whether or not the READ-ONLY attribute is set for this file Public Property Get fATTR_ReadOnly() As Boolean fATTR_ReadOnly = FI_ATTRReadOnly End Property ' Sets the READ-ONLY attribute for this file Public Property Let fATTR_ReadOnly(NewValue As Boolean) On Error GoTo ErrorTrap If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_READONLY Else SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL If FI_ATTRArchive = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_ARCHIVE End If If FI_ATTRCompressed = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_COMPRESSED End If If FI_ATTRHidden = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_HIDDEN End If If FI_ATTRSystem = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_SYSTEM End If If FI_ATTRTemporary = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_TEMPORARY End If End If FI_ATTRReadOnly = NewValue FI_ATTRNormal = False Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the READ-ONLY file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns whether or not the SYSTEM attribute is set for this file Public Property Get fATTR_System() As Boolean fATTR_System = FI_ATTRSystem End Property ' Sets the SYSTEM attribute for this file Public Property Let fATTR_System(NewValue As Boolean) On Error GoTo ErrorTrap If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_SYSTEM Else SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL If FI_ATTRArchive = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_ARCHIVE End If If FI_ATTRCompressed = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_COMPRESSED End If If FI_ATTRHidden = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_HIDDEN End If If FI_ATTRReadOnly = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_READONLY End If If FI_ATTRTemporary = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_TEMPORARY End If End If FI_ATTRSystem = NewValue FI_ATTRNormal = False Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the SYSTEM file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns whether or not the TEMPORARY attribute is set for this file Public Property Get fATTR_Temporary() As Boolean fATTR_Temporary = FI_ATTRTemporary End Property ' Sets the TEMPORARY attribute for this file Public Property Let fATTR_Temporary(NewValue As Boolean) On Error GoTo ErrorTrap If NewValue = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_TEMPORARY Else SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_NORMAL If FI_ATTRArchive = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_ARCHIVE End If If FI_ATTRCompressed = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_COMPRESSED End If If FI_ATTRHidden = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_HIDDEN End If If FI_ATTRReadOnly = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_READONLY End If If FI_ATTRSystem = True Then SetFileAttributes FI_Path32bit, FILE_ATTRIBUTE_SYSTEM End If End If FI_ATTRTemporary = NewValue FI_ATTRNormal = False Exit Property ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Other Error MsgBox Err.Source & " encountered the following error while setting the TEMPORARY file attribute:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Exit Property End If End Property ' Returns the file extention for this file Public Property Get fFileExtention() As String fFileExtention = FI_Extention End Property ' Returns the file's size in bytes Public Property Get fSize() As Long fSize = FI_Size End Property ' Returns the file's size in the format of ##.## KB/MB/GB Public Property Get fSizeFormated() As String fSizeFormated = FI_SizeFormated End Property ' Returns the 32bit (long) path of the specified file Public Property Get fPath32bit() As String fPath32bit = FI_Path32bit End Property ' Returns the 16bit (short) path of the specified file Public Property Get fPath16bit() As String fPath16bit = FI_Path16bit End Property ' Returns the 32bit (long) file name Public Property Get fName32bit() As String fName32bit = FI_Name32bit End Property ' Returns the 16bit (short) file name Public Property Get fName16bit() As String fName16bit = FI_Name16bit End Property ' Returns the type of file Public Property Get fType() As String fType = FI_Type End Property ' Returns what operating system the file was designed for Public Property Get fTargetOS() As String fTargetOS = FI_TargetOS End Property ' Returns the date the file was created Public Property Get fDateCreated() As String fDateCreated = FI_Date_Created End Property ' Returns the date the file was last modified Public Property Get fDateModified() As String fDateModified = FI_Date_Modified End Property ' Returns the date the file was last accessed Public Property Get fDateAccessed() As String fDateAccessed = FI_Date_Accessed End Property ' Returns the full version of the file Public Property Get fVersion() As String fVersion = FI_Version End Property ' Returns the Major Revision number of the file Public Property Get fVersion_Major() As String fVersion_Major = FI_Version_Major End Property ' Returns the Minor Revision number of the file Public Property Get fVersion_Minor() As String fVersion_Minor = FI_Version_Minor End Property ' Returns the Revision number of the file Public Property Get fVersion_Rev() As String fVersion_Rev = FI_Version_Rev End Property ' Returns the file's description Public Property Get fDecription() As String fDecription = FI_Description End Property ' Returns the file's Copyright Public Property Get fCopyright() As String fCopyright = FI_Copyright End Property ' Returns the file's company name Public Property Get fCompanyName() As String fCompanyName = FI_CompanyName End Property ' Returns the file's size when compressed Public Property Get fSizeCompressed() As Long fSizeCompressed = FI_SizeCompressed End Property ' Returns the file's size when compressed formated Public Property Get fSizeCompressedFormated() As String fSizeCompressedFormated = FI_SizeCompressedFm End Property ' Returns the file's icon handle number (use with the GetFileIcon method) ' * NOTE: To make this icon a viewable icon, use the DrawIcon API function Public Property Get fIconH() As Long fIconH = FI_hIcon End Property ' Returns the file's internal name Public Property Get fInternalName() As String fInternalName = FI_InternalName End Property ' Returns the language the program was programed in Public Property Get fLanguage() As String fLanguage = FI_Language End Property ' Returns the file's legal trademark information Public Property Get fLegalTrademark() As String fLegalTrademark = FI_LegalTrademark End Property ' Returns the directory where the file is located Public Property Get fLocation() As String fLocation = FI_Location End Property ' Returns the file's orginal file name Public Property Get fOriginalFileName() As String fOriginalFileName = FI_OriginalFileName End Property ' Returns the file's name while in production / developement Public Property Get fProductName() As String fProductName = FI_ProductName End Property ' Returns the file's product version Public Property Get fProductVersion() As String fProductVersion = FI_ProductVersion End Property '============================================================================================================= ' CLASS METHODS '============================================================================================================= ' Function that returns all variables to blank or the default Public Function ClearFileInfo() On Error Resume Next FI_ATTRNormal = False ' As Boolean FI_ATTRReadOnly = False ' As Boolean FI_ATTRHidden = False ' As Boolean FI_ATTRSystem = False ' As Boolean FI_ATTRArchive = False ' As Boolean FI_ATTRCompressed = False ' As Boolean FI_ATTRTemporary = False ' As Boolean FI_Location = "" ' As String FI_Path32bit = "" ' As String FI_Path16bit = "" ' As String FI_Name32bit = "" ' As String FI_Name16bit = "" ' As String FI_Extention = "" ' As String FI_Date_Accessed = "" ' As String FI_Date_Created = "" ' As String FI_Date_Modified = "" ' As String FI_hIcon = 0 ' As Long FI_Size = 0 ' As Long FI_SizeFormated = "" ' As String FI_SizeCompressed = 0 ' As Long FI_SizeCompressedFm = "" ' As String FI_Type = "" ' As String FI_CompanyName = "" ' As String FI_Copyright = "" ' As String FI_Description = "" ' As String FI_InternalName = "" ' As String FI_Language = "" ' As String FI_LegalTrademark = "" ' As String FI_OriginalFileName = "" ' As String FI_ProductName = "" ' As String FI_ProductVersion = "" ' As String FI_TargetOS = "" ' As String FI_Version = "" ' As String FI_Version_Major = 0 ' As Integer FI_Version_Minor = 0 ' As Integer FI_Version_Rev = 0 ' As Single End Function ' Function that assigns all the variables the correct values Public Function RefreshInfo() On Error Resume Next Dim WFD As WIN32_FIND_DATA Dim sfi As SHFILEINFO Dim hSearch As Long Dim nDummy As Long Dim sBuffer() As Byte Dim lBufferLen As Long Dim lplpBuffer As Long Dim udtVerBuffer As VS_FIXEDFILEINFO Dim puLen As Long Dim sTemp As String Dim sBlock As String Dim nRet As Long ' Check if a file has been specified, and if not... exit If FI_Path32bit = "" Then Exit Function End If ' Check for existence of file. hSearch = FindFirstFile(FI_Path32bit, WFD) If hSearch = INVALID_HANDLE_VALUE Then Exit Function End If FindClose hSearch ' Get file path / name information FI_Name32bit = StripFileFromPath(FI_Path32bit) FI_Path16bit = ConvertLong2Short(FI_Path32bit) FI_Name16bit = StripFileFromPath(FI_Path16bit) FI_Location = Left(FI_Path16bit, Len(FI_Path16bit) - Len(FI_Name16bit)) FI_Extention = StripFileExtention(FI_Name16bit) ' Get normal size information FI_Size = FileLen(FI_Path32bit) FI_SizeFormated = FormatFileSize(FI_Size) ' Get file date information FI_Date_Created = FormatFileDate(FileTimeToDouble(WFD.ftCreationTime, True)) FI_Date_Modified = FormatFileDate(FileTimeToDouble(WFD.ftLastWriteTime, True)) FI_Date_Accessed = FormatFileDate(FileTimeToDouble(WFD.ftLastAccessTime, True)) ' Get icon and descriptive text. If FI_hIcon Then DestroyIcon FI_hIcon FI_hIcon = 0 End If SHGetFileInfo FI_Path32bit, 0&, sfi, Len(sfi), SHGFI_ICON Or SHGFI_DISPLAYNAME Or SHGFI_TYPENAME FI_hIcon = sfi.hIcon ' Confirm displayable typename. FI_Type = TrimNull(sfi.szTypeName) If Trim(FI_Type) = "" Then FI_Type = Trim(UCase(FI_Extention) & " File") End If ' Get the file's attributes FI_ATTRArchive = (WFD.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE) FI_ATTRCompressed = (WFD.dwFileAttributes And FILE_ATTRIBUTE_COMPRESSED) FI_ATTRHidden = (WFD.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) FI_ATTRNormal = (WFD.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) FI_ATTRReadOnly = (WFD.dwFileAttributes And FILE_ATTRIBUTE_READONLY) FI_ATTRSystem = (WFD.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) FI_ATTRTemporary = (WFD.dwFileAttributes And FILE_ATTRIBUTE_TEMPORARY) ' Retrieve compressed size If FI_ATTRCompressed = True Then FI_SizeCompressed = WFD.nFileSizeHigh FI_SizeCompressed = GetCompressedFileSize(FI_Path32bit, FI_SizeCompressed) FI_SizeCompressedFm = FormatFileSize(FI_SizeCompressed) Else FI_SizeCompressed = 0 FI_SizeCompressedFm = "Not Compressed" End If ' Get the size of the version information lBufferLen = GetFileVersionInfoSize(FI_Path32bit, nDummy) If lBufferLen Then ' Store info to udtVerBuffer structure ReDim sBuffer(lBufferLen) GetFileVersionInfo FI_Path32bit, 0&, lBufferLen, sBuffer(0) VerQueryValue sBuffer(0), "\", lplpBuffer, puLen CopyMem udtVerBuffer, ByVal lplpBuffer, Len(udtVerBuffer) ' ' Determine File Version number [This is determined more accurately later] ' FI_Version = Format(udtVerBuffer.dwFileVersionMSh) & "." & Format(udtVerBuffer.dwFileVersionMSl, "00") & "." ' If udtVerBuffer.dwFileVersionLSh > 0 Then ' FI_Version = FI_Version & Format(udtVerBuffer.dwFileVersionLSh, "00") & Format(udtVerBuffer.dwFileVersionLSl, "00") ' Else ' FI_Version = FI_Version & Format(udtVerBuffer.dwFileVersionLSl, "0000") ' End If ' ' ' Determine Product Version number [This is determined more accurately later] ' FI_ProductVersion = Format(udtVerBuffer.dwProductVersionMSh) & "." & Format(udtVerBuffer.dwProductVersionMSl, "00") & "." ' If udtVerBuffer.dwProductVersionLSh > 0 Then ' FI_ProductVersion = FI_ProductVersion & Format(udtVerBuffer.dwProductVersionLSh, "00") & Format(udtVerBuffer.dwProductVersionLSl, "00") ' Else ' FI_ProductVersion = FI_ProductVersion & Format(udtVerBuffer.dwProductVersionLSl, "0000") ' End If End If ' Determine OS for which file was designed Select Case udtVerBuffer.dwFileOS Case VOS_DOS FI_TargetOS = "MS-DOS" Case VOS_DOS_WINDOWS16 FI_TargetOS = "16bit Windows on DOS (Windows 3.0, 3.1x)" Case VOS_DOS_WINDOWS32 FI_TargetOS = "32bit Windows on DOS (Win32s)" Case VOS_NT FI_TargetOS = "Windows NT" Case VOS_NT_WINDOWS32 FI_TargetOS = "Win32 API on Windows NT" Case VOS_OS216 FI_TargetOS = "16bit OS/2" Case VOS_OS216_PM16 FI_TargetOS = "16bit Presentation Manager on 16 bit OS/2" Case VOS_OS232 FI_TargetOS = "32bit OS/2" Case VOS_OS232_PM32 FI_TargetOS = "32-bit Presentation Manager on 32 bit OS/2" Case VOS_UNKNOWN FI_TargetOS = "Undefined or Unknown" Case Else FI_TargetOS = "Undefined or Unknown" End Select ' Get language translations If VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lplpBuffer, puLen) Then If puLen Then sTemp = PointerToStringB(lplpBuffer, puLen) sTemp = Right("0" & Hex(Asc(Mid(sTemp, 2, 1))), 2) & _ Right("0" & Hex(Asc(Mid(sTemp, 1, 1))), 2) & _ Right("0" & Hex(Asc(Mid(sTemp, 4, 1))), 2) & _ Right("0" & Hex(Asc(Mid(sTemp, 3, 1))), 2) sBlock = "\StringFileInfo\" & sTemp & "\" ' Determine language FI_Language = Space(256) nRet = VerLanguageName(CLng("&H" & Left(sTemp, 4)), FI_Language, Len(FI_Language)) If nRet Then FI_Language = Left(FI_Language, nRet) Else FI_Language = "" End If ' Get predefined version resources If VerQueryValue(sBuffer(0), sBlock & "CompanyName", lplpBuffer, puLen) Then If puLen Then FI_CompanyName = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "FileDescription", lplpBuffer, puLen) Then If puLen Then FI_Description = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "FileVersion", lplpBuffer, puLen) Then If puLen Then FI_Version = PointerToString(lplpBuffer) StripVersion FI_Version End If End If If VerQueryValue(sBuffer(0), sBlock & "InternalName", lplpBuffer, puLen) Then If puLen Then FI_InternalName = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "LegalCopyright", lplpBuffer, puLen) Then If puLen Then FI_Copyright = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "LegalTrademarks", lplpBuffer, puLen) Then If puLen Then FI_LegalTrademark = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "OriginalFilename", lplpBuffer, puLen) Then If puLen Then FI_OriginalFileName = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "ProductName", lplpBuffer, puLen) Then If puLen Then FI_ProductName = PointerToString(lplpBuffer) End If End If If VerQueryValue(sBuffer(0), sBlock & "ProductVersion", lplpBuffer, puLen) Then If puLen Then FI_ProductVersion = PointerToString(lplpBuffer) End If End If End If End If End Function ' Function that strips the Major, Minor, & Revision numbers from the Version number Private Function StripVersion(FullVersion As String) On Error Resume Next Dim MyCounter As Integer Dim CharLeft As String Dim CharRight As String Dim DotCount As Integer Dim NumberSoFar As String ' Check if version is valid If FullVersion = "" Then FI_Version_Major = 0 FI_Version_Minor = 0 FI_Version_Rev = 0 ElseIf InStr(FullVersion, ".") = 0 And InStr(FullVersion, ",") Then FI_Version_Major = CInt(FullVersion) FI_Version_Minor = 0 FI_Version_Rev = 0 End If For MyCounter = 0 To Len(FullVersion) CharLeft = Left(FullVersion, MyCounter) CharRight = Right(CharLeft, 1) If CharRight = "." Or CharRight = "," Then Select Case DotCount Case 0 FI_Version_Major = CInt(NumberSoFar) Case 1 FI_Version_Minor = CInt(NumberSoFar) End Select NumberSoFar = "" Else NumberSoFar = NumberSoFar & CharRight End If Next FI_Version_Rev = CSng(NumberSoFar) End Function ' Function that strips out the date or time from a full date ' This function expects to see full date / time in the following format: ' ' , , ' Public Function Strip_DateTime(FullDateTime As String, Optional StripOutTime As Boolean = False, Optional StripOutDate As Boolean = False, Optional FourDigitYear As Boolean = True) As String On Error Resume Next Dim MyCounter As Integer Dim CharLeft As String Dim CharRight As String Dim TheMonth As String Dim TheDay As String Dim TheYear As String Dim TheHour As String Dim TheMin As String Dim TheSec As String Dim TheAMPM As String Dim FoundMonth As Boolean Dim FoundDay As Boolean Dim FoundYear As Boolean Dim FoundMin As Boolean Dim FoundSec As Boolean Dim FoundFirstSpace As Boolean ' Check for a valid full date If (StripOutDate = False And StripOutTime = False) Or FullDateTime = "" Then Exit Function ElseIf InStr(UCase(FullDateTime), Mon) = 0 And _ InStr(UCase(FullDateTime), Tue) = 0 And _ InStr(UCase(FullDateTime), Wed) = 0 And _ InStr(UCase(FullDateTime), Thr) = 0 And _ InStr(UCase(FullDateTime), Fri) = 0 And _ InStr(UCase(FullDateTime), Sat) = 0 And _ InStr(UCase(FullDateTime), Sun) = 0 Then Exit Function ElseIf InStr(FullDateTime, ",") = 0 Or (InStr(UCase(FullDateTime), "AM") = 0 And InStr(UCase(FullDateTime), "PM") = 0) Then Exit Function End If '=============== Stip out the date - Format = MM/DD/YY(YY) ============== If StripOutDate = True Then For MyCounter = 0 To Len(FullDateTime) CharLeft = Left(FullDateTime, MyCounter) ' Check for the month If UCase(Right(CharLeft, Len(Jan))) = Jan Or _ UCase(Right(CharLeft, Len(Feb))) = Feb Or _ UCase(Right(CharLeft, Len(Mar))) = Mar Or _ UCase(Right(CharLeft, Len(Apr))) = Apr Or _ UCase(Right(CharLeft, Len(May))) = May Or _ UCase(Right(CharLeft, Len(Jun))) = Jun Or _ UCase(Right(CharLeft, Len(Jul))) = Jul Or _ UCase(Right(CharLeft, Len(Aug))) = Aug Or _ UCase(Right(CharLeft, Len(Sep))) = Sep Or _ UCase(Right(CharLeft, Len(Ocr))) = Ocr Or _ UCase(Right(CharLeft, Len(Nov))) = Nov Or _ UCase(Right(CharLeft, Len(Dec))) = Dec Then TheMonth = FindTheMonth(CharLeft, False) FoundMonth = True ' Check for the day ElseIf FoundMonth = True And FoundDay = False Then If Right(CharLeft, 1) = "," Then If IsNumeric(Trim(Left(Right(CharLeft, 3), 2))) = True Then TheDay = Trim(Left(Right(CharLeft, 3), 2)) FoundDay = True End If End If ' Check for the year ElseIf FoundDay = True And FoundYear = False Then If Right(CharLeft, 1) = " " And Right(CharLeft, 2) <> ", " Then ' Check for 4 digit year If IsNumeric(Trim(Right(CharLeft, 5))) = True Then TheYear = Trim(Right(CharLeft, 5)) FoundYear = True Strip_DateTime = TheMonth & "/" & TheDay & "/" & TheYear Exit For ' Check for 2 digit year ElseIf IsNumeric(Trim(Right(CharLeft, 3))) = True Then TheYear = Trim(Right(CharLeft, 3)) If FourDigitYear = True Then If CInt(TheYear) > 50 Then TheYear = "19" & TheYear Else TheYear = "20" & TheYear End If End If FoundYear = True Strip_DateTime = TheMonth & "/" & TheDay & "/" & TheYear Exit For End If End If End If Next '=============== Stip out the time - Format = HH:MM:SS AM/PM ============== ElseIf StripOutTime = True Then For MyCounter = 0 To Len(FullDateTime) CharRight = Right(FullDateTime, MyCounter) If UCase(Left(CharRight, 2)) = "AM" Then TheAMPM = "AM" ElseIf UCase(Left(CharRight, 2)) = "PM" Then TheAMPM = "PM" ElseIf Left(CharRight, 1) = ":" Then If FoundSec = False Then If IsNumeric(Right(Left(CharRight, 3), 2)) = True Then TheSec = Right(Left(CharRight, 3), 2) ElseIf IsNumeric(Right(Left(CharRight, 2), 1)) = True Then TheSec = "0" & Right(Left(CharRight, 2), 1) End If FoundSec = True ElseIf FoundMin = False Then If IsNumeric(Right(Left(CharRight, 3), 2)) = True Then TheMin = Right(Left(CharRight, 3), 2) ElseIf IsNumeric(Right(Left(CharRight, 2), 1)) = True Then TheMin = "0" & Right(Left(CharRight, 2), 1) End If FoundMin = True End If ElseIf Left(CharRight, 1) = " " Then If FoundFirstSpace = False Then FoundFirstSpace = True Else If IsNumeric(Right(Left(CharRight, 3), 2)) = True Then TheHour = Right(Left(CharRight, 3), 2) ElseIf IsNumeric(Right(Left(CharRight, 2), 1)) = True Then TheHour = "0" & Right(Left(CharRight, 2), 1) End If Strip_DateTime = TheHour & ":" & TheMin & ":" & TheSec & " " & TheAMPM Exit For End If End If Next End If End Function ' Function that checks input for a month and returns it as a string Private Function FindTheMonth(TheText As String, Optional ReturnString As Boolean = True) As String On Error Resume Next If TheText = "" Then Exit Function End If If ReturnString = True Then If UCase(Right(TheText, Len(Jan))) = Jan Then FindTheMonth = "January" ElseIf UCase(Right(TheText, Len(Feb))) = Feb Then FindTheMonth = "February" ElseIf UCase(Right(TheText, Len(Mar))) = Mar Then FindTheMonth = "March" ElseIf UCase(Right(TheText, Len(Apr))) = Apr Then FindTheMonth = "April" ElseIf UCase(Right(TheText, Len(May))) = May Then FindTheMonth = "May" ElseIf UCase(Right(TheText, Len(Jun))) = Jun Then FindTheMonth = "June" ElseIf UCase(Right(TheText, Len(Jul))) = Jul Then FindTheMonth = "July" ElseIf UCase(Right(TheText, Len(Aug))) = Aug Then FindTheMonth = "August" ElseIf UCase(Right(TheText, Len(Sep))) = Sep Then FindTheMonth = "September" ElseIf UCase(Right(TheText, Len(Ocr))) = Ocr Then FindTheMonth = "October" ElseIf UCase(Right(TheText, Len(Nov))) = Nov Then FindTheMonth = "November" ElseIf UCase(Right(TheText, Len(Dec))) = Dec Then FindTheMonth = "December" End If Else If UCase(Right(TheText, Len(Jan))) = Jan Then FindTheMonth = "01" ElseIf UCase(Right(TheText, Len(Feb))) = Feb Then FindTheMonth = "02" ElseIf UCase(Right(TheText, Len(Mar))) = Mar Then FindTheMonth = "03" ElseIf UCase(Right(TheText, Len(Apr))) = Apr Then FindTheMonth = "04" ElseIf UCase(Right(TheText, Len(May))) = May Then FindTheMonth = "05" ElseIf UCase(Right(TheText, Len(Jun))) = Jun Then FindTheMonth = "06" ElseIf UCase(Right(TheText, Len(Jul))) = Jul Then FindTheMonth = "07" ElseIf UCase(Right(TheText, Len(Aug))) = Aug Then FindTheMonth = "08" ElseIf UCase(Right(TheText, Len(Sep))) = Sep Then FindTheMonth = "09" ElseIf UCase(Right(TheText, Len(Ocr))) = Ocr Then FindTheMonth = "10" ElseIf UCase(Right(TheText, Len(Nov))) = Nov Then FindTheMonth = "11" ElseIf UCase(Right(TheText, Len(Dec))) = Dec Then FindTheMonth = "12" End If End If End Function ' This function checks if a file exists by opening it then closing it. ' The other way to check if a file exists is to use the DIR() function, ' but the DIR() function doesn't work if the file is hidden. Public Function CheckIfFileExists(strFullPath As String) As Boolean On Error GoTo FileNotFound Dim FileDoesntExist As Boolean Close #1 Open strFullPath For Input As #1 Close #1 If FileDoesntExist = True Then CheckIfFileExists = False Else CheckIfFileExists = True End If Exit Function FileNotFound: If Err.Number = 0 Then Resume Next ElseIf Err.Number = 20 Then Resume Next Else Err.Clear FileDoesntExist = True Resume Next End If End Function ' Function that takes a 32bit file path and converts it to ' the 16bit equivelant file path Public Function ConvertLong2Short(strFullPath As String) As String On Error Resume Next Dim Length As Long Dim Short_Path As String Dim Long_Path As String If CheckIfFileExists(strFullPath) = False Then MsgBox strFullPath & Chr(13) & Chr(13) & "Could not find this file to convert to 16bit file name.", vbOKOnly + vbExclamation, " File Not Found" Exit Function End If Long_Path = strFullPath Short_Path = Space(1024) Length = GetShortPathName(Long_Path, Short_Path, Len(Short_Path)) ConvertLong2Short = UCase(Left(Short_Path, Length)) End Function ' Function to strip the file name out of a full path Public Function StripFileFromPath(strFullPath As String) As String On Error Resume Next Dim MyCounter As Integer Dim CharLeft As String Dim CharRight As String If strFullPath = "" Then Exit Function ElseIf InStr(strFullPath, "\") = 0 Then StripFileFromPath = strFullPath Exit Function End If For MyCounter = 0 To Len(strFullPath) CharRight = Right(strFullPath, MyCounter) CharLeft = Left(CharRight, 1) If CharLeft = "\" Then StripFileFromPath = Right(CharRight, Len(CharRight) - 1) Exit Function End If Next End Function ' Function that extracts the file extension from a file name or file path Public Function StripFileExtention(strFileName As String) As String On Error Resume Next Dim MyCounter As Integer Dim CharRight As String Dim CharLeft As String If InStr(strFileName, ".") = 0 Then StripFileExtention = "" Exit Function End If For MyCounter = 0 To Len(strFileName) CharRight = Right(strFileName, MyCounter) CharLeft = Left(CharRight, 1) If CharLeft = "." Then StripFileExtention = Right(strFileName, Len(CharRight) - 1) Exit Function End If Next End Function ' Function that formats the file size in bytes into KB/MB/GB Private Function FormatFileSize(TheSize As Long) As String On Error Resume Next Const KB As Long = 1024 Const MB As Long = KB * KB Dim FormatSoFar As String ' Return size of file in kilobytes. If TheSize = -1 Then FormatFileSize = "0.0KB (0 bytes)" ElseIf TheSize < KB Then FormatSoFar = Format(TheSize, "#,##0") & " bytes" Else Select Case TheSize \ KB Case Is < 10 FormatSoFar = Format(TheSize / KB, "0.00") & "KB" Case Is < 100 FormatSoFar = Format(TheSize / KB, "0.0") & "KB" Case Is < 1000 FormatSoFar = Format(TheSize / KB, "0.0") & "KB" Case Is < 10000 FormatSoFar = Format(TheSize / MB, "0.00") & "MB" Case Is < 100000 FormatSoFar = Format(TheSize / MB, "0.0") & "MB" Case Is < 1000000 FormatSoFar = Format(TheSize / MB, "0.0") & "MB" Case Is < 10000000 FormatSoFar = Format(TheSize / MB / KB, "0.00") & "GB" End Select FormatSoFar = FormatSoFar & " (" & Format(TheSize, "#,##0") & " bytes)" End If FormatFileSize = FormatSoFar End Function ' Function that takes a date and formats it into long date format Private Function FormatFileDate(TheDate As Double) As String On Error Resume Next FormatFileDate = Format(TheDate, "long date") & " " & Format(TheDate, "long time") End Function ' Function that takes the file's time and converts it to double for use later Private Function FileTimeToDouble(ftUTC As FILETIME, Localize As Boolean) As Double On Error Resume Next Dim FT As FILETIME Dim ST As SYSTEMTIME Dim d As Double Dim T As Double ' Convert to local filetime, if necessary If Localize Then FileTimeToLocalFileTime ftUTC, FT Else FT = ftUTC End If ' Convert to system time structure FileTimeToSystemTime FT, ST ' Convert to VB-style date (double) FileTimeToDouble = DateSerial(ST.wYear, ST.wMonth, ST.wDay) + TimeSerial(ST.wHour, ST.wMinute, ST.wSecond) End Function ' Function that trims off null characters Private Function TrimNull(StrIn As String) As String On Error Resume Next Dim Nul As Long ' Truncate input string at first null. If no nulls, perform ordinary Trim. Nul = InStr(StrIn, vbNullChar) Select Case Nul Case Is > 1 TrimNull = Left(StrIn, Nul - 1) Case 1 TrimNull = "" Case 0 TrimNull = Trim(StrIn) End Select End Function ' Function that draws the file's icon onto the object specified by the hDC ' ' hDC = The Device Context (hDC) of the object to draw the icon on ' X = The Left position of where the icon should be drawn on the object ' Y = The Top position of where the icon should be drawn on the object ' hIcon = The handle of the icon to draw - Use the fIconH property for this Public Function GetFileIcon(hDC As Long, X As Long, Y As Long, hIcon As Long) On Error Resume Next ' NOTE: Make sure that the AutoRedraw property of the object to be ' drawn on is set to TRUE, else the icon will not draw right If hIcon = 0 Then Exit Function End If DrawIcon hDC, X, Y, FI_hIcon End Function ' Function to get a string stored at a pointer address Private Function PointerToString(LPString As Long) As String On Error Resume Next Dim Buffer As String Dim nLen As Long If LPString Then nLen = lstrlenA(LPString) If nLen Then Buffer = Space(nLen) CopyMem ByVal Buffer, ByVal LPString, nLen PointerToString = Buffer End If End If End Function ' Function to get a string stored at a pointer address Private Function PointerToStringB(LPString As Long, nBytes As Long) As String On Error Resume Next Dim Buffer As String If nBytes Then Buffer = Space(nBytes) CopyMem ByVal Buffer, ByVal LPString, nBytes PointerToStringB = Buffer End If End Function