Previous VB6 methods for listing file properties haven't used the newer methods, which are especially handy if you're already working with IShellItem. This code is a tour of the modern property system, covering PROPERTYKEY, IPropertyStore, IPropertyDescription, and propsys.dll APIs to take raw values and format them according to the system locale; e.g. adding 'pixels' or 'dpi' to image properties, showing dates/times according to system settings, changing the unreadable number representing attributes into letters, etc. It also goes on to show the raw data, exposing an important method if you do need to work with PROPVARIANT in VB.
Requirements
-Requires oleexp 1.8 or higher (released Jun 1 2015) (for IDE only, add references to olelib.tlb and oleexp.tlb)
-Only works with Windows Vista and higher
Code
Sample output:
Also, if your user is selecting which properties to display, which is still done by column IDs, you can map a column id to a PROPERTYKEY like this, where isfPar is the IShellFolder2 the properties are selected from:
Requirements
-Requires oleexp 1.8 or higher (released Jun 1 2015) (for IDE only, add references to olelib.tlb and oleexp.tlb)
-Only works with Windows Vista and higher
Code
Code:
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Function SHCreateItemFromIDList Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any) As Long
Public Declare Function CoInitialize Lib "ole32.dll" (ByVal pvReserved As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) ' Frees memory allocated by the shell
Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Public Declare Function PSGetNameFromPropertyKey Lib "propsys.dll" (PropKey As PROPERTYKEY, ppszCanonicalName As Long) As Long
Public Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As PROPERTYKEY, riid As UUID, ppv As Any) 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 PropVariantToVariant Lib "propsys.dll" (ByRef propvar As Any, ByRef var As Variant) As Long
Public Sub EnumFileProperties(sPath As String)
'sPath can be a file or a folder. Other objects that you might want properties
'for, a slight re-work can be used to start from its pidl or IShellItem directly
Dim isif As IShellItem2
Dim pidlt As Long
Dim pProp As IPropertyDescription
Dim pk As PROPERTYKEY
Dim pPStore As IPropertyStore
Dim lpe As Long
Dim lpProp As Long
Dim i As Long, j As Long
Dim vProp As Variant
Dim vrProp As Variant
Dim vte As VbVarType
Dim sPrName As String
Dim sFmtProp As String
Call CoInitialize(0)
'Create a reference to IShellItem2
pidlt = ILCreateFromPathW(StrPtr(sPath))
Call SHCreateItemFromIDList(pidlt, IID_IShellItem2, isif)
Call CoTaskMemFree(pidlt)
If (isif Is Nothing) Then
Debug.Print "Failed to get IShellItem2"
Exit Sub
End If
'Get the IPropertyStore interface
isif.GetPropertyStore GPS_DEFAULT, IID_IPropertyStore, pPStore
If (pPStore Is Nothing) Then
Debug.Print "Failed to get IPropertyStore"
Exit Sub
End If
'Get the number of properties
pPStore.GetCount lpe
Debug.Print "Total number of properties=" & lpe
On Error GoTo eper
For i = 0 To (lpe - 1)
'Loop through each property; starting with information about which property we're working with
pPStore.GetAt i, pk
PSGetNameFromPropertyKey pk, lpProp
sPrName = BStrFromLPWStr(lpProp)
Debug.Print "Property Name=" & sPrName & ",SCID={" & Hex$(pk.fmtid.Data1) & "-" & Hex$(pk.fmtid.Data2) & "-" & Hex$(pk.fmtid.Data3) & "-" & Hex$(pk.fmtid.Data4(0)) & Hex$(pk.fmtid.Data4(1)) & "-" & Hex$(pk.fmtid.Data4(2)) & Hex$(pk.fmtid.Data4(3)) & Hex$(pk.fmtid.Data4(4)) & Hex$(pk.fmtid.Data4(5)) & Hex$(pk.fmtid.Data4(6)) & Hex$(pk.fmtid.Data4(7)) & "}, " & pk.pid
'Some properties don't return a name; if you don't catch that it leads to a full appcrash
If Len(sPrName) > 1 Then
'PSFormatPropertyValue takes the raw data and formats it according to the current locale
'Using these APIs lets us completely avoid dealing with PROPVARIANT, a huge bonus.
'If you don't need the raw data, this is all it takes
PSGetPropertyDescription pk, IID_IPropertyDescription, pProp
PSFormatPropertyValue ObjPtr(pPStore), ObjPtr(pProp), PDFF_DEFAULT, lpProp
sFmtProp = BStrFromLPWStr(lpProp)
Debug.Print "Formatted value=" & sFmtProp
Else
Debug.Print "Unknown Propkey; can't get formatted value"
End If
'Now we'll display the raw data
isif.GetProperty pk, vProp
PropVariantToVariant vProp, vrProp 'PROPVARIANT is exceptionally difficult to work with in VB, but at
'least for file properties this seems to work for most
vte = VarType(vrProp)
If (vte And vbArray) = vbArray Then 'this always seems to be vbString and vbArray, haven't encountered other types
For j = LBound(vrProp) To UBound(vrProp)
Debug.Print "Value(" & j & ")=" & CStr(vrProp(j))
Next j
Else
Select Case vte
Case vbDataObject, vbObject, vbUserDefinedType
Debug.Print "<cannot display this type>"
Case vbEmpty, vbNull
Debug.Print "<empty or null>"
Case vbError
Debug.Print "<vbError>"
Case Else
Debug.Print "Value=" & CStr(vrProp)
End Select
End If
Next i
Exit Sub
eper:
Debug.Print "Property conversion error->" & Err.Description
Resume Next
End Sub
'Supporting functions
Public Function IID_IShellItem2() As UUID
'7e9fb0d3-919f-4307-ab2e-9b1860310c93
Static IID As UUID
If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H7E9FB0D3, CInt(&H919F), CInt(&H4307), &HAB, &H2E, &H9B, &H18, &H60, &H31, &HC, &H93)
IID_IShellItem2 = IID
End Function
Public Function IID_IPropertyDescription() As UUID
'(IID_IPropertyDescription, 0x6f79d558, 0x3e96, 0x4549, 0xa1,0xd1, 0x7d,0x75,0xd2,0x28,0x88,0x14
Static IID As UUID
If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H6F79D558, CInt(&H3E96), CInt(&H4549), &HA1, &HD1, &H7D, &H75, &HD2, &H28, &H88, &H14)
IID_IPropertyDescription = IID
End Function
Public Function IID_IPropertyStore() As UUID
'DEFINE_GUID(IID_IPropertyStore,0x886d8eeb, 0x8cf2, 0x4446, 0x8d,0x02,0xcd,0xba,0x1d,0xbd,0xcf,0x99);
Static IID As UUID
If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H886D8EEB, CInt(&H8CF2), CInt(&H4446), &H8D, &H2, &HCD, &HBA, &H1D, &HBD, &HCF, &H99)
IID_IPropertyStore = IID
End Function
Public Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
With Name
.Data1 = L
.Data2 = w1
.Data3 = w2
.Data4(0) = B0
.Data4(1) = b1
.Data4(2) = b2
.Data4(3) = B3
.Data4(4) = b4
.Data4(5) = b5
.Data4(6) = b6
.Data4(7) = b7
End With
End Sub
Public Function BStrFromLPWStr(lpWStr As Long, Optional ByVal CleanupLPWStr As Boolean = True) As String
SysReAllocString VarPtr(BStrFromLPWStr), lpWStr
If CleanupLPWStr Then CoTaskMemFree lpWStr
End FunctionCode:
Property Name=System.FileAttributes,SCID={B725F130-47EF-101A-A5F1-2608C9EEBAC}, 13
Formatted value=A
Value=32Code:
isfPar.MapColumnToSCID lColumn, SHColEx
pk.fmtid = SHColEx.fmtid
pk.pid = SHColEx.pid
