Speciální adresáře

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _ 
(ByVal hwndOwner As Long, ByVal nFolder As SpecialFolderIDs, _ 
ByRef pIdl As Long) As Long 

Private Declare Function SHGetPathFromIDListA Lib "shell32" _ 
(ByVal pIdl As Long, ByVal pszPath As String) As Long 

Private Const NOERROR = 0 
Private Const gintMAX_PATH_LEN% = 260 

'ID Speciálních adresářů
Public Enum SpecialFolderIDs 
   sfidDESKTOP = &H0 
   sfidPROGRAMS = &H2 
   sfidPERSONAL = &H5 
   sfidFAVORITES = &H6 
   sfidSTARTUP = &H7 
   sfidRECENT = &H8 
   sfidSENDTO = &H9 
   sfidSTARTMENU = &HB 
   sfidDESKTOPDIRECTORY = &H10 
   sfidNETHOOD = &H13 
   sfidFONTS = &H14 
   sfidTEMPLATES = &H15 
   sfidCOMMON_STARTMENU = &H16 
   sfidCOMMON_PROGRAMS = &H17 
   sfidCOMMON_STARTUP = &H18 
   sfidCOMMON_DESKTOPDIRECTORY = &H19 
   sfidAPPDATA = &H1A 
   sfidPRINTHOOD = &H1B 
   sfidProgramFiles = &H10000 
   sfidCommonFiles = &H10001 
End Enum 

Public Function GetSpecialFolderLocation _
            (sFolder As SpecialFolderIDs) As String 

   ' Tato funkce vrátí cestu k umístnění speciálního adresáře.
   'Stačí poslat ID adresáře. 
   Dim sPath As String 
   Dim IDL As Long 
   Dim nPos As Long 

   ' Zjištění PIDL speciálního adresáře 
   If SHGetSpecialFolderLocation(0, sFolder, IDL) = NOERROR Then 
      sPath = String$(gintMAX_PATH_LEN, 0) 
      ' Převod identifikátoru na systémovou cestu 
      SHGetPathFromIDListA IDL, sPath 
      ' Nyní je třeba ořezat případné NULL znaky 
      nPos = InStr(1, sPath, Chr$(0)) 
      If nPos > 0 Then 
         ' NULL znaky nalezeny 
         GetSpecialFolderLocation = Left(sPath, nPos - 1) 
      Else 
         GetSpecialFolderLocation = sPath 
      End If 
   End If 

End Function

Příklad volání:

Dim sPath As String 
sPath = GetSpecialFolderLocation(sfidFAVORITES)

Proměnná sPath pak bude obsahovat cestu k oblíbeným položkám.

Zpět