|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Browse/ PIDL / CSIDL
Routines SHGetSpecialFolderLocation: Retrieve Windows Shell Folders |
||
Posted: | Saturday May 17, 1997 | |
Updated: | Monday December 26, 2011 | |
Applies to: | VB4-32, VB5, VB6 | |
Developed with: | VB4-32, Windows 95 | |
OS restrictions: | Win2000 or WinNT4, Win95, Win98 with appropriate DLL upgrades | |
Author: | VBnet - Randy Birch | |
Related: | BROWSE: SHBrowseForFolder: Browse Folders Dialog Overview SHBrowseForFolder: Browse for Folders Dialog SHBrowseForFolder: Browse for Folders Callback Overview SHBrowseForFolder: Pre-selecting Folders using a Browse Callback SHBrowseForFolder: Browse for Folders New UI Features CSIDL / Folders: |
|
Prerequisites |
Win2000 or WinNT4, Win95, Win98 with appropriate DLL upgrades provided as part of service packs or IE releases. |
|
This page is wider than I prefer to post to accommodate the constant descriptions. It will appear fine pasted into a VB project. While the SHGetFolderPath API is promoted as a Best Practice by Microsoft, this API, not in shell32.dll, is not always present on all older systems. This page then is the same routine shown on the SHGetFolderPath page, but instead uses the familiar SHGetSpecialFolderPath and corresponding APIs to retrieve the special folder locations on a user's system that are included with earlier versions of shell32. While it may be questionable as to why bother using the Best Practice method of SHGetFolderPath, it must be remembered that SHGetFolderPath is provided in a redistributable DLL (SHFolder.dll), and that the new API simulates many of the new shell folders on older platforms such as Windows 95, Windows 98, and Windows NT 4.0. On systems with SHFolder.dll, SHGetFolderPath always calls the current platform's version of this function - and if it fails, tries to simulate the appropriate behaviour. Note that some constants represent non-file system elements (e.g. Drives, Nethood) which are part of Windows explorer namespace. These elements do not return file system paths and so may not return a value to the textbox when selected. |
BAS Module Code |
None. |
|
Form Code |
To a project form add a text box (Text1) and a Combo (Combo1) set to style 2. Add the following to the form: |
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Const CSIDL_DESKTOP = &H0 '{desktop} Private Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop) Private Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs Private Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel Private Const CSIDL_PRINTERS = &H4 'My Computer\Printers Private Const CSIDL_PERSONAL = &H5 'My Documents Private Const CSIDL_FAVORITES = &H6 '{user}\Favourites Private Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup Private Const CSIDL_RECENT = &H8 '{user}\Recent Private Const CSIDL_SENDTO = &H9 '{user}\SendTo Private Const CSIDL_BITBUCKET = &HA '{desktop}\Recycle Bin Private Const CSIDL_STARTMENU = &HB '{user}\Start Menu Private Const CSIDL_DESKTOPDIRECTORY = &H10 '{user}\Desktop Private Const CSIDL_DRIVES = &H11 'My Computer Private Const CSIDL_NETWORK = &H12 'Network Neighbourhood Private Const CSIDL_NETHOOD = &H13 '{user}\nethood Private Const CSIDL_FONTS = &H14 'windows\fonts Private Const CSIDL_TEMPLATES = &H15 Private Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu Private Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs Private Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19'All Users\Desktop Private Const CSIDL_APPDATA = &H1A '{user}\Application Data Private Const CSIDL_PRINTHOOD = &H1B '{user}\PrintHood Private Const CSIDL_LOCAL_APPDATA = &H1C '{user}\Local Settings _ '\Application Data (non roaming) Private Const CSIDL_ALTSTARTUP = &H1D 'non localized startup Private Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup Private Const CSIDL_COMMON_FAVORITES = &H1F Private Const CSIDL_INTERNET_CACHE = &H20 Private Const CSIDL_COOKIES = &H21 Private Const CSIDL_HISTORY = &H22 Private Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data Private Const CSIDL_WINDOWS = &H24 'GetWindowsDirectory() Private Const CSIDL_SYSTEM = &H25 'GetSystemDirectory() Private Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files Private Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures Private Const CSIDL_PROFILE = &H28 'USERPROFILE Private Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC Private Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC Private Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common Private Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC Private Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates Private Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents Private Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs _ '\Administrative Tools Private Const CSIDL_ADMINTOOLS = &H30 '{user}\Start Menu\Programs _ '\Administrative Tools Private Const CSIDL_FLAG_CREATE = &H8000& 'combine with CSIDL_ value to force 'create on SHGetSpecialFolderLocation() Private Const CSIDL_FLAG_DONT_VERIFY = &H4000 'combine with CSIDL_ value to force 'create on SHGetSpecialFolderLocation() Private Const CSIDL_FLAG_MASK = &HFF00 'mask for all possible flag values Private Const SHGFP_TYPE_CURRENT = &H0 'current value for user, verify it exists Private Const SHGFP_TYPE_DEFAULT = &H1 Private Const MAX_PATH As Long = 260 Private Const S_OK = 0 'Converts an item identifier list to a file system path. Private Declare Function SHGetPathFromIDList Lib "shell32" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ pidl As Long) As Long Private Declare Sub CoTaskMemFree Lib "ole32" _ (ByVal pv As Long) Private Sub Form_Load() With Combo1 .Font.Name = "Courier New" .Font.Size = 9 .AddItem "CSIDL_DESKTOP {desktop}" .ItemData(.NewIndex) = &H0 .AddItem "CSIDL_INTERNET Internet Explorer (icon on desktop)" .ItemData(.NewIndex) = &H1 .AddItem "CSIDL_PROGRAMS Start Menu\Programs" .ItemData(.NewIndex) = &H2 .AddItem "CSIDL_CONTROLS My Computer\Control Panel" .ItemData(.NewIndex) = &H3 .AddItem "CSIDL_PRINTERS My Computer\Printers" .ItemData(.NewIndex) = &H4 .AddItem "CSIDL_PERSONAL My Documents" .ItemData(.NewIndex) = &H5 .AddItem "CSIDL_FAVORITES {user}\Favourites" .ItemData(.NewIndex) = &H6 .AddItem "CSIDL_STARTUP Start Menu\Programs\Startup" .ItemData(.NewIndex) = &H7 .AddItem "CSIDL_RECENT {user}\Recent" .ItemData(.NewIndex) = &H8 .AddItem "CSIDL_SENDTO {user}\SendTo" .ItemData(.NewIndex) = &H9 .AddItem "CSIDL_BITBUCKET {desktop}\Recycle Bin" .ItemData(.NewIndex) = &HA .AddItem "CSIDL_STARTMENU {user}\Start Menu" .ItemData(.NewIndex) = &HB .AddItem "CSIDL_DESKTOPDIRECTORY {user}\Desktop" .ItemData(.NewIndex) = &H10 .AddItem "CSIDL_DRIVES My Computer" .ItemData(.NewIndex) = &H11 .AddItem "CSIDL_NETWORK Network Neighbourhood" .ItemData(.NewIndex) = &H12 .AddItem "CSIDL_NETHOOD {user}\nethood" .ItemData(.NewIndex) = &H13 .AddItem "CSIDL_FONTS windows\fonts" .ItemData(.NewIndex) = &H14 .AddItem "CSIDL_TEMPLATES" .ItemData(.NewIndex) = &H15 .AddItem "CSIDL_COMMON_STARTMENU All Users\Start Menu" .ItemData(.NewIndex) = &H16 .AddItem "CSIDL_COMMON_PROGRAMS All Users\Programs" .ItemData(.NewIndex) = &H17 .AddItem "CSIDL_COMMON_STARTUP All Users\Startup" .ItemData(.NewIndex) = &H18 .AddItem "CSIDL_COMMON_DESKTOPDIRECTORY All Users\Desktop" .ItemData(.NewIndex) = &H19 .AddItem "CSIDL_APPDATA {user}\Application Data" .ItemData(.NewIndex) = &H1A .AddItem "CSIDL_PRINTHOOD {user}\PrintHood" .ItemData(.NewIndex) = &H1B .AddItem "CSIDL_LOCAL_APPDATA {user}\Local Settings\Application Data (non roaming)" .ItemData(.NewIndex) = &H1C .AddItem "CSIDL_ALTSTARTUP non localized startup" .ItemData(.NewIndex) = &H1D .AddItem "CSIDL_COMMON_ALTSTARTUP non localized common startup" .ItemData(.NewIndex) = &H1E .AddItem "CSIDL_COMMON_FAVORITES" .ItemData(.NewIndex) = &H1F .AddItem "CSIDL_INTERNET_CACHE" .ItemData(.NewIndex) = &H20 .AddItem "CSIDL_COOKIES" .ItemData(.NewIndex) = &H21 .AddItem "CSIDL_HISTORY" .ItemData(.NewIndex) = &H22 .AddItem "CSIDL_COMMON_APPDATA All Users\Application Data" .ItemData(.NewIndex) = &H23 .AddItem "CSIDL_WINDOWS GetWindowsDirectory()" .ItemData(.NewIndex) = &H24 .AddItem "CSIDL_SYSTEM GetSystemDirectory()" .ItemData(.NewIndex) = &H25 .AddItem "CSIDL_PROGRAM_FILES C:\Program Files" .ItemData(.NewIndex) = &H26 .AddItem "CSIDL_MYPICTURES C:\Program Files\My Pictures" .ItemData(.NewIndex) = &H27 .AddItem "CSIDL_PROFILE USERPROFILE" .ItemData(.NewIndex) = &H28 .AddItem "CSIDL_SYSTEMX86 x86 system directory on RISC" .ItemData(.NewIndex) = &H29 .AddItem "CSIDL_PROGRAM_FILESX86 x86 C:\Program Files on RISC" .ItemData(.NewIndex) = &H2A .AddItem "CSIDL_PROGRAM_FILES_COMMON C:\Program Files\Common" .ItemData(.NewIndex) = &H2B .AddItem "CSIDL_PROGRAM_FILES_COMMONX86 x86 Program Files\Common on RISC" .ItemData(.NewIndex) = &H2C .AddItem "CSIDL_COMMON_TEMPLATES All Users\Templates" .ItemData(.NewIndex) = &H2D .AddItem "CSIDL_COMMON_DOCUMENTS All Users\Documents" .ItemData(.NewIndex) = &H2E .AddItem "CSIDL_COMMON_ADMINTOOLS All Users\Start Menu\Programs\Administrative Tools" .ItemData(.NewIndex) = &H2F .AddItem "CSIDL_ADMINTOOLS {user}\Start Menu\Programs\Administrative Tools" .ItemData(.NewIndex) = &H30 End With End Sub Private Function GetSpecialFolderLocation(CSIDL As Long) As String Dim sPath As String Dim pidl As Long 'fill the idl structure with the specified folder item If SHGetSpecialFolderLocation(Me.hWnd, CSIDL, pidl) = S_OK Then 'if the pidl is returned, initialize 'and get the path from the id list sPath = Space$(MAX_PATH) If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then 'return the path GetSpecialFolderLocation = Left(sPath, InStr(sPath, Chr$(0)) - 1) End If 'free the pidl Call CoTaskMemFree(pidl) End If End Function Private Sub Combo1_Click() Dim index As Long index = Combo1.ItemData(Combo1.ListIndex) If index > -1 Then Text1.Text = GetSpecialFolderLocation(index) End If End Sub |
Comments |
Run and select an item from the combo. If the selected item represents a physical folder, and you system supports the call, the folder path will be displayed in the textbox. Remember that virtual folders never return a physical path. |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |