Attribute VB_Name = "mShellDefs"
Option Explicit

Declare Function FlashWindow Lib "user32" (ByVal hWnd As Long, ByVal bInvert As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)


Public Const NOERROR = 0

Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                              (ByVal hwndOwner As Long, _
                              ByVal nFolder As SHSpecialFolderIDs, _
                              pidl As Long) As Long

Public Enum SHSpecialFolderIDs
  CSIDL_DESKTOP = &H0
  CSIDL_INTERNET = &H1
  CSIDL_PROGRAMS = &H2
  CSIDL_CONTROLS = &H3
  CSIDL_PRINTERS = &H4
  CSIDL_PERSONAL = &H5
  CSIDL_FAVORITES = &H6
  CSIDL_STARTUP = &H7
  CSIDL_RECENT = &H8
  CSIDL_SENDTO = &H9
  CSIDL_BITBUCKET = &HA
  CSIDL_STARTMENU = &HB
  CSIDL_DESKTOPDIRECTORY = &H10
  CSIDL_DRIVES = &H11
  CSIDL_NETWORK = &H12
  CSIDL_NETHOOD = &H13
  CSIDL_FONTS = &H14
  CSIDL_TEMPLATES = &H15
  CSIDL_COMMON_STARTMENU = &H16
  CSIDL_COMMON_PROGRAMS = &H17
  CSIDL_COMMON_STARTUP = &H18
  CSIDL_COMMON_DESKTOPDIRECTORY = &H19
  CSIDL_APPDATA = &H1A
  CSIDL_PRINTHOOD = &H1B
  CSIDL_ALTSTARTUP = &H1D
  CSIDL_COMMON_ALTSTARTUP = &H1E
  CSIDL_COMMON_FAVORITES = &H1F
  CSIDL_INTERNET_CACHE = &H20
  CSIDL_COOKIES = &H21
  CSIDL_HISTORY = &H22
End Enum

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                              (ByVal pidl As Long, _
                              ByVal pszPath As String) As Long

Declare Function SHGetFileInfoPidl Lib "shell32" Alias "SHGetFileInfoA" _
                              (ByVal pidl As Long, _
                              ByVal dwFileAttributes As Long, _
                              psfib As SHFILEINFOBYTE, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFOBYTE
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName(1 To MAX_PATH) As Byte
  szTypeName(1 To 80) As Byte
End Type

Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _
                              (ByVal pszPath As String, _
                              ByVal dwFileAttributes As Long, _
                              psfi As SHFILEINFO, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFO
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type
Enum SHGFI_flags
  SHGFI_LARGEICON = &H0
  SHGFI_SMALLICON = &H1
  SHGFI_OPENICON = &H2
  SHGFI_SHELLICONSIZE = &H4
  SHGFI_PIDL = &H8
  SHGFI_USEFILEATTRIBUTES = &H10
  SHGFI_ICON = &H100
  SHGFI_DISPLAYNAME = &H200
  SHGFI_TYPENAME = &H400
  SHGFI_ATTRIBUTES = &H800
  SHGFI_ICONLOCATION = &H1000
                                                            
  SHGFI_EXETYPE = &H2000
  SHGFI_SYSICONINDEX = &H4000
  SHGFI_LINKOVERLAY = &H8000
  SHGFI_SELECTED = &H10000
End Enum

Public Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As Long
  Dim pidl As Long
  If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then
    GetPIDLFromFolderID = pidl
  End If
End Function
Public Function GetDisplayNameFromPIDL(pidl As Long) As String
  Dim sfib As SHFILEINFOBYTE
  If SHGetFileInfoPidl(pidl, 0, sfib, Len(sfib), SHGFI_PIDL Or SHGFI_DISPLAYNAME) Then
    GetDisplayNameFromPIDL = GetStrFromBufferA(StrConv(sfib.szDisplayName, vbUnicode))
  End If
End Function
Public Function GetPathFromPIDL(pidl As Long) As String
  Dim sPath As String * MAX_PATH
  If SHGetPathFromIDList(pidl, sPath) Then
    GetPathFromPIDL = GetStrFromBufferA(sPath)
  End If
End Function
Public Function GetStrFromBufferA(sz As String) As String
  If InStr(sz, vbNullChar) Then
    GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
  Else
    GetStrFromBufferA = sz
  End If
End Function