Very simple, powerfull and handy routine for correct icon indexing from the shell

[nebeln]

This routine is by far the most powerfull, simple and robust routine for indexing of shellicons I have come up with for FS objects as well as Virtual objects. Works from Win XP and above. And no need of any typelibs.
Also very effortless in memory usage. No time & memory consuming extractions at all.
So get rid of your existing routines and replace it with this tiny one.
Handle both normal and open icons.
You can also use it for all sizes you wish ie small, medium, large, extra large or custom size. (It handles "under the hood" IImageList interface which allows resizing on the fly without clearing the imagelist).

Public Const S_OK = 0&
Public Const S_ERR = 1

Public Declare Function SHGetDesktopFolder Lib "shell32.dll" (ByRef ppshf As Long) As Long
Public Declare Function SHMapPIDLToSystemImageListIndex Lib "shell32.dll" (Byref pshf As Long, ByVal pidl As Long,Byref piIndex As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pidlorMem As Long)

Public Function IID_IShellFolder() As GUID
  Dim lpIID As GUID
  
  '000214E6-0000-0000-C000-000000000046
  lpIID.Data1 = &H214E6
  lpIID.Data2 = &H0
  lpIID.Data3 = &H0
  lpIID.Data4(0) = &HC0
  lpIID.Data4(1) = &H0
  lpIID.Data4(2) = &H0
  lpIID.Data4(3) = &H0
  lpIID.Data4(4) = &H0
  lpIID.Data4(5) = &H0
  lpIID.Data4(6) = &H0
  lpIID.Data4(7) = &H46
  
  IID_IShellFolder = lpIID
End Function

Public Function SHGetItemIconIndex(ByVal pidlItem As Long, ByRef nIconIndex As Long, Optional nOpenIconIndex As Long) As Long
   Dim pidl As Long
   Dim pidlChild As Long
   Dim ppISF As Long
   Dim nIconSize As Long
   Dim sIconFile As String

   pidl = pidlItem
   
   If pidl Then
      'You can put in if statement here if you feel for it. (If hr = S_OK Then)
      SHBindToParent pidl, IID_IShellFolder, ppISF, pidlChild
      If ppISF = 0 Then SHGetDesktopFolder ppISF
      nIconIndex = SHMapPIDLToSystemImageListIndex(ByVal ppISF, pidlChild, nOpenIconIndex)
      
      Debug.Print "nIconIndex: " & nIconIndex
      Debug.Print "nOpenIconIndex: " & nOpenIconIndex
      
      CoTaskMemFree pidl      
      CoTaskMemFree ppISF
      ppISF = 0

      If (nIconIndex <> -1) And (nOpenIconIndex <> -1) Then
         SHGetItemIconIndex = S_OK
      Else
         SHGetItemIconIndex = S_ERR
      End If
   End If

Happy Coding