[VB6, Vista+] List all file properties, locale/unit formatted, by modern PROPERTYKEY

[fafalone]

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.

Note that the project does have the option to hide empty properties:



Requirements
-Requires oleexp 4.0 or higher (for IDE only, add reference to oleexp.tlb)
-mIID.bas (included with oleexp)
-Only works with Windows Vista and higher

UPDATE: (2015Dec05) - I think I would have heard about it if it was always the case; but on my system, office documents were counted as slow items even on the OS drive, and getting the IPropertyStore for them failed (0x80040154 Class not registered). This is resolved by adding flags to open slow items and always return a property store, even if some properties couldn't be loaded.

UPDATE: (2015Dec05-2) - I'm attaching a sample project that shows these properties in a ListView. The values are locally formatted, printed to the LV in Unicode, and the project shows how to load ALL (as opposed to some/most-- trickier than you think) properties into a management array, for not only showing files like the demo, but as an easy system to track Details columns in an Explorer-type file list.
Project requirements- attached sample project
(the requirements for the sample code in this post haven't changed, but the attached project does things different and uses more recent things)
-Windows Vista or higher
-oleexp v4.0 or higher
-oleexp addon mIID.bas for IID_ entries (included with oleexp)

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 Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, 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 Function

Sample output:

Property Name=System.FileAttributes,SCID={B725F130-47EF-101A-A5F1-2608C9EEBAC}, 13
Formatted value=A
Value=32

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:

            isfPar.MapColumnToSCID lColumn, SHColEx
            pk.fmtid = SHColEx.fmtid
            pk.pid = SHColEx.pid

Reminder: The attached project uses a slightly different method than the code in this post, and has a bunch of other features.


NOTE
If you're missing a property you can see in Explorer, like I noticed GPS longitude/latitude, they're not in the PDEF_VIEWABLE property enumeration this sample uses, which avoids properties that don't apply to files and lots of duplicates, but also some less common ones like GPS. So if you're looking for a missing property you saw in Explorer, at the bottom of the InitPKEYs function, change it to PDEF_SYSTEM and then if that doesn't have it, PDEF_ALL.

---

twinBASIC 64bit compatible version at https://github.com/fafalone/MiscDemos