Printable View
Hi dears
I have an explorer in my project, i want to see selected file's details (file property) like (Name, Size, Format, ...etc.)
how can i code for it
-----------------------------------------------
my code for file format is : Label1.Caption = UCase(Right(File1.Path + "\" + File1.FileName, 3)) It is ok but for other details
i need your helps
:)
Mahmood,
Which details are you after? You've got to already have the name to get anything else, so it seems a bit silly to be asking for that one.
Regarding Size, either Len or Lof should do the job for you. If you also want size-on-disk, that might be a bit trickier.
Regarding some of the other properties, here are a few functions for you. And maybe they'll serve as a guide for you to get other information as well:
Enjoy,Code:
Option Explicit
'
Private Const MAX_PATH = 260
'
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
' &h01 bit = read only
' &h02 bit = hidden
' &h04 bit = system
' &h10 bit = folder
' &h20 bit = archive
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 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 ' = &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
'
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 GetFileTime 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
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile 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 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 VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
'
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = &H3
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
'
Public Function FileVersion(sFileSpec As String) As String
Dim rc As Long
Dim lDummy As Long
Dim sBuffer() As Byte
Dim lBufferLen As Long
Dim lVerPointer As Long
Dim udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long
'
lBufferLen = GetFileVersionInfoSize(sFileSpec, lDummy)
If lBufferLen < 1 Then Exit Function
'
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(sFileSpec, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
CopyMemory udtVerBuffer, lVerPointer, LenB(udtVerBuffer)
'
FileVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
End Function
Public Function ProductVersion(sFileSpec As String) As String
Dim rc As Long
Dim lDummy As Long
Dim sBuffer() As Byte
Dim lBufferLen As Long
Dim lVerPointer As Long
Dim udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long
'
lBufferLen = GetFileVersionInfoSize(sFileSpec, lDummy)
If lBufferLen < 1 Then Exit Function
'
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(sFileSpec, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
CopyMemory udtVerBuffer, lVerPointer, LenB(udtVerBuffer)
'
ProductVersion = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
End Function
Public Function GetFileTimes(sFileSpec As String, bConvertToLocalTime As Boolean, dtCreationDate As Date, dtAccessDate As Date, dtModifiedDate As Date) As Boolean
' Returns TRUE on success, FALSE on fail.
' dtCreationDate, dtAccessDate, & dtModifiedDate are returned if successful.
Dim file_handle As Long
Dim creation_filetime As FILETIME
Dim access_filetime As FILETIME
Dim modified_filetime As FILETIME
Dim file_time As FILETIME
Dim sa As SECURITY_ATTRIBUTES
'
' Open the file.
file_handle = CreateFile(sFileSpec, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, sa, OPEN_EXISTING, 0&, 0&)
If file_handle = 0 Then Exit Function
'
' Get the times.
If GetFileTime(file_handle, creation_filetime, access_filetime, modified_filetime) = 0 Then
CloseHandle file_handle
Exit Function
End If
'
' Close the file.
If CloseHandle(file_handle) = 0 Then Exit Function
'
' See if we should convert to the local file system time.
If bConvertToLocalTime Then
' Convert to local file system time.
FileTimeToLocalFileTime creation_filetime, file_time
creation_filetime = file_time
'
FileTimeToLocalFileTime access_filetime, file_time
access_filetime = file_time
'
FileTimeToLocalFileTime modified_filetime, file_time
modified_filetime = file_time
End If
'
' Convert into dates.
dtCreationDate = FileTimeToDate(creation_filetime)
dtAccessDate = FileTimeToDate(access_filetime)
dtModifiedDate = FileTimeToDate(modified_filetime)
'
GetFileTimes = True ' We succeeded.
End Function
Public Function FileSize(sFileSpec As String) As Long
' This will not work correctly for files over 2 gig.
' Also, if the file doesn't exist, it returns zero.
Dim wfd As WIN32_FIND_DATA
Dim h As Long
Const INVALID_HANDLE_VALUE = -1
'
h = FindFirstFile(sFileSpec, wfd)
If h = INVALID_HANDLE_VALUE Then Exit Function
'
FileSize = wfd.nFileSizeLow
End Function
Public Function FileCreatedDate(sFileSpec As String) As Date
' If the file doesn't exist, it returns zero (12/30/1899 midnight).
Dim wfd As WIN32_FIND_DATA
Dim h As Long
Const INVALID_HANDLE_VALUE = -1
'
h = FindFirstFile(sFileSpec, wfd)
If h = INVALID_HANDLE_VALUE Then Exit Function
'
FileCreatedDate = dFileTimeToDouble(wfd.ftCreationTime, True)
End Function
Public Function FileModifiedDate(sFileSpec As String) As Date
' If the file doesn't exist, it returns zero (12/30/1899 midnight).
Dim wfd As WIN32_FIND_DATA
Dim h As Long
Const INVALID_HANDLE_VALUE = -1
'
h = FindFirstFile(sFileSpec, wfd)
If h = INVALID_HANDLE_VALUE Then Exit Function
'
FileModifiedDate = dFileTimeToDouble(wfd.ftLastWriteTime, True)
End Function
Public Function FileAccessedDate(sFileSpec As String) As Date
' If the file doesn't exist, it returns zero (12/30/1899 midnight).
Dim wfd As WIN32_FIND_DATA
Dim h As Long
Const INVALID_HANDLE_VALUE = -1
'
h = FindFirstFile(sFileSpec, wfd)
If h = INVALID_HANDLE_VALUE Then Exit Function
'
FileAccessedDate = dFileTimeToDouble(wfd.ftLastAccessTime, True)
End Function
Private Function dFileTimeToDouble(ftUTC As FILETIME, Optional Localize As Boolean = False) As Double
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).
dFileTimeToDouble = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond)
End Function
Private Function FileTimeToDate(FT As FILETIME) As Date
Dim stLocal As SYSTEMTIME
Const ZERO_DATE As Date = 0!
'
If (FT.dwHighDateTime <> 0) And (FT.dwLowDateTime <> 0) Then
FileTimeToSystemTime FT, stLocal
FileTimeToDate = DateSerial(stLocal.wYear, stLocal.wMonth, stLocal.wDay) + TimeSerial(stLocal.wHour, stLocal.wMinute, stLocal.wSecond)
Else
FileTimeToDate = ZERO_DATE
End If
End Function
Elroy
Thank you I knew the name but I write them for better understanding of my question.Quote:
Originally Posted by Elroy
Have you a Simpler Example? It is So big for me to understand and use. I'm so bad in programming :(
However Thank you for your nice code! :wave:
Geez Elroy. If you're going to get that complex you might as well show a FULL display...
http://i.imgur.com/2FBaHSK.jpg
Actually I take that back, as doing this is less complex :P
[VB6, Vista+] List all file properties, locale/unit formatted, by modern PROPERTYKEY
Edit: If you just want to look up individual properties,
(with oleexp.tlb/mIID.bas present)Code:Public Declare Function PSGetPropertyKeyFromName Lib "propsys.dll" (ByVal pszName As Long, ppropkey As PROPERTYKEY) As Long
Public Declare Function PSFormatPropertyValue Lib "propsys.dll" (ByVal pps As Long, ByVal ppd As Long, ByVal pdff As PROPDESC_FORMAT_FLAGS, ppszDisplay As Long) As Long
Public Declare Function SHGetPropertyStoreFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, ByVal Flags As GETPROPERTYSTOREFLAGS, riid As UUID, ppv As Any) As Long
Public Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As PROPERTYKEY, riid As UUID, ppv As Any) As Long
Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Public Function GetPropertyDisplayString(szFile As String, szProp As String) As String
'Gets the string value of the given canonical property; e.g. System.Company, System.Rating, etc
'This would be the value displayed in Explorer if you added the column in details view
Dim pkProp As PROPERTYKEY
Dim pps As IPropertyStore
Dim lpsz As Long
Dim ppd As IPropertyDescription
PSGetPropertyKeyFromName StrPtr(szProp), pkProp
SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
SysReAllocString VarPtr(GetPropertyDisplayString), lpsz
CoTaskMemFree lpsz
End Function
You use that function with the property name, e.g. szSize = GetPropertyDisplayString("C:\myfile.jpg", "System.Size") and it would return "100 KB" or whatever the size was, already formatted like Explorer. See: [VB6, Vista+] A compact function to retrieve any property by name, locally formatted
Quote:
Originally Posted by fafalone
Thank You dear fafalone it looks helpful :)
Hi fafalone,
Yeah, I just pulled out what I had in my main application. I use those functions above to decide whether or not to update certain SxS OCX files that are packed into my executable.
Thanks for providing a link to your more fleshed-out version of procedures that provide file properties.
Best Regards,
Elroy
Here's another one which pulls out all the extended Props it can find,
(working without API-Declares or TypeLibs):
OlafCode:Option Explicit
Private Sub Form_Load()
Debug.Print GetExtProps("c:\temp", "test.png")
End Sub
Public Function GetExtProps(Folder, File)
Dim FF, FI, i, j, EP()
Set FF = CreateObject("Shell.Application").NameSpace(Folder)
For i = 0 To 8191
If Len(FF.GetDetailsOf(FF, i)) = 0 Then ReDim EP(0 To i - 1): Exit For
Next
Set FI = FF.ParseName(File)
For i = 0 To UBound(EP)
EP(j) = Replace(Replace(Replace(FF.GetDetailsOf(FI, i), _
ChrW(8206), ""), ChrW(8234), ""), ChrW(8236), "")
If Len(EP(j)) Then EP(j) = FF.GetDetailsOf(FF, i) & ": " & EP(j): j = j + 1
Next
ReDim Preserve EP(j - 1)
GetExtProps = Join(EP, vbCrLf)
End Function
As the 2nd project in my post mentions, there's an even better way for individual properties;
My typelib (oleexp) comes with a module called mPKEY.bas, it's got PROPERTYKEY's for all of the properties (there's hundreds), so you don't need to worry about figuring out technical names like System.Whatever, you can just browse through the list. ... if you use mPKEY:
Depending on what control you're displaying that in and how you're setting it, you probably want to strip out ChrW$(&H200E) and ChrW$(&H200F); they're formatting characters that will show as ? in non-unicode controls.Code:Public Function GetPropertyKeyDisplayString(szFile As String, pkProp As PROPERTYKEY) As String
Dim pps As IPropertyStore
Dim lpsz As Long
Dim ppd As IPropertyDescription
SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
SysReAllocString VarPtr(GetPropertyKeyDisplayString), lpsz
CoTaskMemFree lpsz
End Function
If you're getting a fair number of properties from a large number of files, performance comes into play, and you might want to only open the property store once per file, here's a function I use to keep it to one call per file, that also removes those unneeded format characters (leave them in if you're supporting Unicode Right-To-Left languages):
Called like:Code:Public Function GetPropertyKeyDisplayStringSet(szFile As String, pkProp() As PROPERTYKEY) As String()
'Gets the string value of the given canonical property; e.g. System.Company, System.Rating, etc
'This would be the value displayed in Explorer if you added the column in details view
Dim pps As IPropertyStore
Dim lpsz As Long
Dim ppd As IPropertyDescription
Dim arOut() As String
Dim i As Long
Dim sz As String
ReDim arOut(UBound(pkProp))
SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
For i = 0 To UBound(pkProp)
PSGetPropertyDescription pkProp(i), IID_IPropertyDescription, ppd
PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
SysReAllocString VarPtr(sz), lpsz
arOut(i) = Replace$(sz, ChrW$(&H200E), "")
arOut(i) = Replace$(arOut(i), ChrW$(&H200F), "")
CoTaskMemFree lpsz
Next i
GetPropertyKeyDisplayStringSet = arOut
End Function
Code:Dim pkys() As PROPERTYKEY
ReDim pkys(3)
Dim fProps() As String
pkys(0) = PKEY_FileName
pkys(1) = PKEY_DateModified
pkys(2) = PKEY_Image_HorizontalSize
pkys(3) = PKEY_Image_VerticalSize
fProps = GetPropertyKeyDisplayStringSet("C:\temp2\64.png", pkys)
txtName.Text = fProps(0)
txtModified.Text = fProps(1)
txtWidth.Text = fProps(2)
txtHeight.Text = fProps(3)