[Vista+] Code Snippet: Get and set the Rating (stars) of a file

[fafalone]

In Explorer, things like Pictures and some other types have a 'Rating' property category that shows a 0-5 star rating. You can get and set this rating programmatically, and this also provides a basis for getting and setting other properties. Requires oleexp, v2.0 or higher.

Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Sub ILFree Lib "shell32" (ByVal pidl As Long)
Public Declare Function SHCreateItemFromIDList Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any) As Long

Public Function GetFileRating(sFile As String) As Long
'Returns the star rating of a file in number of stars
Dim pidl As Long
Dim isi As IShellItem2
Dim lp As Long
Dim pkRating As PROPERTYKEY '{64440492-4C8B-11D1-8B70-080036B11A03}, 9

DEFINE_PROPERTYKEY pkRating, &H64440492, CInt(&H4C8B), CInt(&H11D1), &H8B, &H70, &H8, &H0, &H36, &HB1, &H1A, &H3, 9

'first, get the shell item representing the file
pidl = ILCreateFromPathW(StrPtr(sFile))
Call SHCreateItemFromIDList(pidl, IID_IShellItem2, isi)

isi.GetUInt32 pkRating, lp 'it's a VT_UI4; 4-byte unsigned integer, which VB's Long can fill in for since a rating can't exceed 99 and be valid

Select Case lp
    Case 1 To 12 'sys default when you assign values in Explorer=1
        lp = 1
    Case 13 To 37 'default=25
        lp = 2
    Case 38 To 62 'default=50
        lp = 3
    Case 63 To 87 'default=75
        lp = 4
    Case 88 To 99 'default=99
        lp = 5
    Case Else
        lp = 0
End Select
GetFileRating = lp
Set isi = Nothing
Call ILFree(pidl) 'always release the memory used by pidls

End Function

Public Function SetFileRating(sFile As String, lNumberOfStars As Long) As Long
'Sets the star rating of a file. Should return 0 if things go ok.
Dim vvar As Variant
Dim lRating As Long
Dim isi As IShellItem2
Dim pidlFile As Long
Dim pps As IPropertyStore
Dim hr As Long
Dim pkRating As PROPERTYKEY '{64440492-4C8B-11D1-8B70-080036B11A03}, 9

DEFINE_PROPERTYKEY pkRating, &H64440492, CInt(&H4C8B), CInt(&H11D1), &H8B, &H70, &H8, &H0, &H36, &HB1, &H1A, &H3, 9

'The rating could technically be anything from 0 to 99; here I use the values that would be used if you set the rating in Explorer
Select Case lNumberOfStars
    Case 1: lRating = 1
    Case 2: lRating = 25
    Case 3: lRating = 50
    Case 4: lRating = 75
    Case 5: lRating = 99
    Case Else: lRating = 0
End Select
vvar = CVar(lRating) 'the property system will expect a PROPVARIANT, but in this case (not all cases), VariantToPropVariant isn't needed, we'll pass vvar directly

'We need the Property Store for the file, which we can get from its IShellItem
pidlFile = ILCreateFromPathW(StrPtr(sFile))
Call SHCreateItemFromIDList(pidlFile, IID_IShellItem2, isi)
    
isi.GetPropertyStore GPS_READWRITE, IID_IPropertyStore, pps 'we need write access- GPS_DEFAULT will not work
   
hr = pps.SetValue(pkRating, vvar) 'returns S_OK if successful
    
If hr = 0 Then
    hr = pps.Commit 'save the changes; returns S_OK if successful
End If

Set pps = Nothing
Set isi = Nothing
Call ILFree(pidlFile) 'always set your pidl free!

SetFileRating = hr
End Function

Public Sub DEFINE_PROPERTYKEY(Name As PROPERTYKEY, 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, pid As Long)
  With Name.fmtid
    .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
  Name.pid = pid
End Sub

If you're not using the mIID.bas from the oleexp thread, also include this:

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 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_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

If you want to display these values in ListView of files, here's a good place to start.