View Issue Details

IDProjectCategoryView StatusLast Update
0033133FPCRTLpublic2018-02-24 14:31
ReporterDenis KozlovAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityN/A
Status resolvedResolutionfixed 
Product VersionProduct BuildTRUNK 
Target Version3.2.0Fixed in Version3.1.1 
Summary0033133: Improved windirs.GetWindowsSpecialDir to use newer API when available
DescriptionImproved windirs.GetWindowsSpecialDir to use newer API when available.

SHGetFolderPath - requires Windows 2000 and newer, but has been deprecated.
SHGetKnownFolderPath - requires Windows Vista / Server 2008 and newer.

The attached patch contains the following changes:
1. Added FOLDERID_* constants, required for SHGetKnownFolderPath.
2. Added mapping of legacy CSIDL_* constants to FOLDERID_* constants.
3. Overloaded GetWindowsSpecialDir to work with both CSIDL_* or FOLDERID_* constants.
4. Changed GetWindowsSpecialDir to fallback to an alternative API (using appropriate remapping of parameters) when the default API function is not available.

Existing code that uses GetWindowsSpecialDir(CSIDL_*) should not be affected, except for an improved forward compatibility when the deprecated SHGetFolderPath is finally removed from Windows API, in which case a newer API function will be used automatically.
Additional InformationRelevant discussion on the mailing list:
http://lists.freepascal.org/pipermail/fpc-devel/2018-February/038564.html
Tagspatch
Fixed in Revision38328
FPCOldBugId
FPCTarget
Attached Files
  • windirs.pp.patch (24,331 bytes)
    Index: rtl/win/windirs.pp
    ===================================================================
    --- rtl/win/windirs.pp	(revision 38125)
    +++ rtl/win/windirs.pp	(working copy)
    @@ -11,6 +11,10 @@
     is called. New applications should use the known folder system rather than the older
     CSIDL system, which is supported only for backward compatibility.
     
    +Official list of CSIDL and FOLDERID constants:
    +https://msdn.microsoft.com/en-us/library/windows/desktop/bb762494.aspx
    +https://msdn.microsoft.com/en-us/library/windows/desktop/dd378457.aspx
    +
     *******************************************************************************}
     
     {$mode objfpc}
    @@ -18,10 +22,8 @@
     
     interface
     
    -uses
    -  windows;
    -
     // CSIDL_* contants are also declared in "ShellApi" and "shfolder" units.
    +// If changed, remember to add an appropriate mapping in CSIDLtoFOLDERID list.
     const
       CSIDL_PROGRAMS                = $0002; { %SYSTEMDRIVE%\Program Files                                      }
       CSIDL_PERSONAL                = $0005; { %USERPROFILE%\My Documents                                       }
    @@ -34,6 +36,7 @@
       CSIDL_MYVIDEO                 = $000E; { %USERPROFILE%\Documents\My Videos                                }
       CSIDL_DESKTOPDIRECTORY        = $0010; { %USERPROFILE%\Desktop                                            }
       CSIDL_NETHOOD                 = $0013; { %USERPROFILE%\NetHood                                            }
    +  CSIDL_FONTS                   = $0014; { %SYSTEMROOT%\Fonts                                               }
       CSIDL_TEMPLATES               = $0015; { %USERPROFILE%\Templates                                          }
       CSIDL_COMMON_STARTMENU        = $0016; { %PROFILEPATH%\All users\Start menu                               }
       CSIDL_COMMON_PROGRAMS         = $0017; { %PROFILEPATH%\All users\Start menu\Programs                      }
    @@ -62,22 +65,237 @@
       CSIDL_COMMON_VIDEO            = $0037; { %PROFILEPATH%\All Users\Documents\my videos                      }
       CSIDL_CDBURN_AREA             = $003B; { %USERPROFILE%\Local Settings\Application Data\Microsoft\CD Burning }
       CSIDL_PROFILES                = $003E; { %PROFILEPATH%                                                    }
    +  // NOTE: CSIDL_PROFILES has been removed from Microsoft official documentation!
     
       CSIDL_FLAG_CREATE             = $8000; { (force creation of requested folder if it doesn't exist yet)     }
     
    +// FOLDERID_* constants parsed from KnownFolders.h file in
    +// Windows 10 SDK for Fall Creators Update (10.0.16299.91).
    +// If changed, remember to add an appropriate mapping in CSIDLtoFOLDERID list.
    +const
    +  FOLDERID_AccountPictures         : TGUID = '{008CA0B1-55B4-4C56-B8A8-4DE4B299D3BE}';
    +  FOLDERID_AddNewPrograms          : TGUID = '{DE61D971-5EBC-4F02-A3A9-6C82895E5C04}';
    +  FOLDERID_AdminTools              : TGUID = '{724EF170-A42D-4FEF-9F26-B60E846FBA4F}';
    +  FOLDERID_AllAppMods              : TGUID = '{7AD67899-66AF-43BA-9156-6AAD42E6C596}';
    +  FOLDERID_AppCaptures             : TGUID = '{EDC0FE71-98D8-4F4A-B920-C8DC133CB165}';
    +  FOLDERID_AppDataDesktop          : TGUID = '{B2C5E279-7ADD-439F-B28C-C41FE1BBF672}';
    +  FOLDERID_AppDataDocuments        : TGUID = '{7BE16610-1F7F-44AC-BFF0-83E15F2FFCA1}';
    +  FOLDERID_AppDataFavorites        : TGUID = '{7CFBEFBC-DE1F-45AA-B843-A542AC536CC9}';
    +  FOLDERID_AppDataProgramData      : TGUID = '{559D40A3-A036-40FA-AF61-84CB430A4D34}';
    +  FOLDERID_AppUpdates              : TGUID = '{A305CE99-F527-492B-8B1A-7E76FA98D6E4}';
    +  FOLDERID_ApplicationShortcuts    : TGUID = '{A3918781-E5F2-4890-B3D9-A7E54332328C}';
    +  FOLDERID_AppsFolder              : TGUID = '{1E87508D-89C2-42F0-8A7E-645A0F50CA58}';
    +  FOLDERID_CDBurning               : TGUID = '{9E52AB10-F80D-49DF-ACB8-4330F5687855}';
    +  FOLDERID_CameraRoll              : TGUID = '{AB5FB87B-7CE2-4F83-915D-550846C9537B}';
    +  FOLDERID_CameraRollLibrary       : TGUID = '{2B20DF75-1EDA-4039-8097-38798227D5B7}';
    +  FOLDERID_ChangeRemovePrograms    : TGUID = '{DF7266AC-9274-4867-8D55-3BD661DE872D}';
    +  FOLDERID_CommonAdminTools        : TGUID = '{D0384E7D-BAC3-4797-8F14-CBA229B392B5}';
    +  FOLDERID_CommonOEMLinks          : TGUID = '{C1BAE2D0-10DF-4334-BEDD-7AA20B227A9D}';
    +  FOLDERID_CommonPrograms          : TGUID = '{0139D44E-6AFE-49F2-8690-3DAFCAE6FFB8}';
    +  FOLDERID_CommonStartMenu         : TGUID = '{A4115719-D62E-491D-AA7C-E74B8BE3B067}';
    +  FOLDERID_CommonStartMenuPlaces   : TGUID = '{A440879F-87A0-4F7D-B700-0207B966194A}';
    +  FOLDERID_CommonStartup           : TGUID = '{82A5EA35-D9CD-47C5-9629-E15D2F714E6E}';
    +  FOLDERID_CommonTemplates         : TGUID = '{B94237E7-57AC-4347-9151-B08C6C32D1F7}';
    +  FOLDERID_ComputerFolder          : TGUID = '{0AC0837C-BBF8-452A-850D-79D08E667CA7}';
    +  FOLDERID_ConflictFolder          : TGUID = '{4BFEFB45-347D-4006-A5BE-AC0CB0567192}';
    +  FOLDERID_ConnectionsFolder       : TGUID = '{6F0CD92B-2E97-45D1-88FF-B0D186B8DEDD}';
    +  FOLDERID_Contacts                : TGUID = '{56784854-C6CB-462B-8169-88E350ACB882}';
    +  FOLDERID_ControlPanelFolder      : TGUID = '{82A74AEB-AEB4-465C-A014-D097EE346D63}';
    +  FOLDERID_Cookies                 : TGUID = '{2B0F765D-C0E9-4171-908E-08A611B84FF6}';
    +  FOLDERID_CurrentAppMods          : TGUID = '{3DB40B20-2A30-4DBE-917E-771DD21DD099}';
    +  FOLDERID_Desktop                 : TGUID = '{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}';
    +  FOLDERID_DevelopmentFiles        : TGUID = '{DBE8E08E-3053-4BBC-B183-2A7B2B191E59}';
    +  FOLDERID_Device                  : TGUID = '{1C2AC1DC-4358-4B6C-9733-AF21156576F0}';
    +  FOLDERID_DeviceMetadataStore     : TGUID = '{5CE4A5E9-E4EB-479D-B89F-130C02886155}';
    +  FOLDERID_Documents               : TGUID = '{FDD39AD0-238F-46AF-ADB4-6C85480369C7}';
    +  FOLDERID_DocumentsLibrary        : TGUID = '{7B0DB17D-9CD2-4A93-9733-46CC89022E7C}';
    +  FOLDERID_Downloads               : TGUID = '{374DE290-123F-4565-9164-39C4925E467B}';
    +  FOLDERID_Favorites               : TGUID = '{1777F761-68AD-4D8A-87BD-30B759FA33DD}';
    +  FOLDERID_Fonts                   : TGUID = '{FD228CB7-AE11-4AE3-864C-16F3910AB8FE}';
    +  FOLDERID_GameTasks               : TGUID = '{054FAE61-4DD8-4787-80B6-090220C4B700}';
    +  FOLDERID_Games                   : TGUID = '{CAC52C1A-B53D-4EDC-92D7-6B2E8AC19434}';
    +  FOLDERID_History                 : TGUID = '{D9DC8A3B-B784-432E-A781-5A1130A75963}';
    +  FOLDERID_HomeGroup               : TGUID = '{52528A6B-B9E3-4ADD-B60D-588C2DBA842D}';
    +  FOLDERID_HomeGroupCurrentUser    : TGUID = '{9B74B6A3-0DFD-4F11-9E78-5F7800F2E772}';
    +  FOLDERID_ImplicitAppShortcuts    : TGUID = '{BCB5256F-79F6-4CEE-B725-DC34E402FD46}';
    +  FOLDERID_InternetCache           : TGUID = '{352481E8-33BE-4251-BA85-6007CAEDCF9D}';
    +  FOLDERID_InternetFolder          : TGUID = '{4D9F7874-4E0C-4904-967B-40B0D20C3E4B}';
    +  FOLDERID_Libraries               : TGUID = '{1B3EA5DC-B587-4786-B4EF-BD1DC332AEAE}';
    +  FOLDERID_Links                   : TGUID = '{BFB9D5E0-C6A9-404C-B2B2-AE6DB6AF4968}';
    +  FOLDERID_LocalAppData            : TGUID = '{F1B32785-6FBA-4FCF-9D55-7B8E7F157091}';
    +  FOLDERID_LocalAppDataLow         : TGUID = '{A520A1A4-1780-4FF6-BD18-167343C5AF16}';
    +  FOLDERID_LocalDocuments          : TGUID = '{F42EE2D3-909F-4907-8871-4C22FC0BF756}';
    +  FOLDERID_LocalDownloads          : TGUID = '{7D83EE9B-2244-4E70-B1F5-5393042AF1E4}';
    +  FOLDERID_LocalMusic              : TGUID = '{A0C69A99-21C8-4671-8703-7934162FCF1D}';
    +  FOLDERID_LocalPictures           : TGUID = '{0DDD015D-B06C-45D5-8C4C-F59713854639}';
    +  FOLDERID_LocalVideos             : TGUID = '{35286A68-3C57-41A1-BBB1-0EAE73D76C95}';
    +  FOLDERID_LocalizedResourcesDir   : TGUID = '{2A00375E-224C-49DE-B8D1-440DF7EF3DDC}';
    +  FOLDERID_Music                   : TGUID = '{4BD8D571-6D19-48D3-BE97-422220080E43}';
    +  FOLDERID_MusicLibrary            : TGUID = '{2112AB0A-C86A-4FFE-A368-0DE96E47012E}';
    +  FOLDERID_NetHood                 : TGUID = '{C5ABBF53-E17F-4121-8900-86626FC2C973}';
    +  FOLDERID_NetworkFolder           : TGUID = '{D20BEEC4-5CA8-4905-AE3B-BF251EA09B53}';
    +  FOLDERID_Objects3D               : TGUID = '{31C0DD25-9439-4F12-BF41-7FF4EDA38722}';
    +  FOLDERID_OneDrive                : TGUID = '{A52BBA46-E9E1-435F-B3D9-28DAA648C0F6}';
    +  FOLDERID_OriginalImages          : TGUID = '{2C36C0AA-5812-4B87-BFD0-4CD0DFB19B39}';
    +  FOLDERID_PhotoAlbums             : TGUID = '{69D2CF90-FC33-4FB7-9A0C-EBB0F0FCB43C}';
    +  FOLDERID_Pictures                : TGUID = '{33E28130-4E1E-4676-835A-98395C3BC3BB}';
    +  FOLDERID_PicturesLibrary         : TGUID = '{A990AE9F-A03B-4E80-94BC-9912D7504104}';
    +  FOLDERID_Playlists               : TGUID = '{DE92C1C7-837F-4F69-A3BB-86E631204A23}';
    +  FOLDERID_PrintHood               : TGUID = '{9274BD8D-CFD1-41C3-B35E-B13F55A758F4}';
    +  FOLDERID_PrintersFolder          : TGUID = '{76FC4E2D-D6AD-4519-A663-37BD56068185}';
    +  FOLDERID_Profile                 : TGUID = '{5E6C858F-0E22-4760-9AFE-EA3317B67173}';
    +  FOLDERID_ProgramData             : TGUID = '{62AB5D82-FDC1-4DC3-A9DD-070D1D495D97}';
    +  FOLDERID_ProgramFiles            : TGUID = '{905E63B6-C1BF-494E-B29C-65B732D3D21A}';
    +  FOLDERID_ProgramFilesCommon      : TGUID = '{F7F1ED05-9F6D-47A2-AAAE-29D317C6F066}';
    +  FOLDERID_ProgramFilesCommonX64   : TGUID = '{6365D5A7-0F0D-45E5-87F6-0DA56B6A4F7D}';
    +  FOLDERID_ProgramFilesCommonX86   : TGUID = '{DE974D24-D9C6-4D3E-BF91-F4455120B917}';
    +  FOLDERID_ProgramFilesX64         : TGUID = '{6D809377-6AF0-444B-8957-A3773F02200E}';
    +  FOLDERID_ProgramFilesX86         : TGUID = '{7C5A40EF-A0FB-4BFC-874A-C0F2E0B9FA8E}';
    +  FOLDERID_Programs                : TGUID = '{A77F5D77-2E2B-44C3-A6A2-ABA601054A51}';
    +  FOLDERID_Public                  : TGUID = '{DFDF76A2-C82A-4D63-906A-5644AC457385}';
    +  FOLDERID_PublicDesktop           : TGUID = '{C4AA340D-F20F-4863-AFEF-F87EF2E6BA25}';
    +  FOLDERID_PublicDocuments         : TGUID = '{ED4824AF-DCE4-45A8-81E2-FC7965083634}';
    +  FOLDERID_PublicDownloads         : TGUID = '{3D644C9B-1FB8-4F30-9B45-F670235F79C0}';
    +  FOLDERID_PublicGameTasks         : TGUID = '{DEBF2536-E1A8-4C59-B6A2-414586476AEA}';
    +  FOLDERID_PublicLibraries         : TGUID = '{48DAF80B-E6CF-4F4E-B800-0E69D84EE384}';
    +  FOLDERID_PublicMusic             : TGUID = '{3214FAB5-9757-4298-BB61-92A9DEAA44FF}';
    +  FOLDERID_PublicPictures          : TGUID = '{B6EBFB86-6907-413C-9AF7-4FC2ABF07CC5}';
    +  FOLDERID_PublicRingtones         : TGUID = '{E555AB60-153B-4D17-9F04-A5FE99FC15EC}';
    +  FOLDERID_PublicUserTiles         : TGUID = '{0482AF6C-08F1-4C34-8C90-E17EC98B1E17}';
    +  FOLDERID_PublicVideos            : TGUID = '{2400183A-6185-49FB-A2D8-4A392A602BA3}';
    +  FOLDERID_QuickLaunch             : TGUID = '{52A4F021-7B75-48A9-9F6B-4B87A210BC8F}';
    +  FOLDERID_Recent                  : TGUID = '{AE50C081-EBD2-438A-8655-8A092E34987A}';
    +  FOLDERID_RecordedCalls           : TGUID = '{2F8B40C2-83ED-48EE-B383-A1F157EC6F9A}';
    +  FOLDERID_RecordedTVLibrary       : TGUID = '{1A6FDBA2-F42D-4358-A798-B74D745926C5}';
    +  FOLDERID_RecycleBinFolder        : TGUID = '{B7534046-3ECB-4C18-BE4E-64CD4CB7D6AC}';
    +  FOLDERID_ResourceDir             : TGUID = '{8AD10C31-2ADB-4296-A8F7-E4701232C972}';
    +  FOLDERID_RetailDemo              : TGUID = '{12D4C69E-24AD-4923-BE19-31321C43A767}';
    +  FOLDERID_Ringtones               : TGUID = '{C870044B-F49E-4126-A9C3-B52A1FF411E8}';
    +  FOLDERID_RoamedTileImages        : TGUID = '{AAA8D5A5-F1D6-4259-BAA8-78E7EF60835E}';
    +  FOLDERID_RoamingAppData          : TGUID = '{3EB685DB-65F9-4CF6-A03A-E3EF65729F3D}';
    +  FOLDERID_RoamingTiles            : TGUID = '{00BCFC5A-ED94-4E48-96A1-3F6217F21990}';
    +  FOLDERID_SEARCH_CSC              : TGUID = '{EE32E446-31CA-4ABA-814F-A5EBD2FD6D5E}';
    +  FOLDERID_SEARCH_MAPI             : TGUID = '{98EC0E18-2098-4D44-8644-66979315A281}';
    +  FOLDERID_SampleMusic             : TGUID = '{B250C668-F57D-4EE1-A63C-290EE7D1AA1F}';
    +  FOLDERID_SamplePictures          : TGUID = '{C4900540-2379-4C75-844B-64E6FAF8716B}';
    +  FOLDERID_SamplePlaylists         : TGUID = '{15CA69B3-30EE-49C1-ACE1-6B5EC372AFB5}';
    +  FOLDERID_SampleVideos            : TGUID = '{859EAD94-2E85-48AD-A71A-0969CB56A6CD}';
    +  FOLDERID_SavedGames              : TGUID = '{4C5C32FF-BB9D-43B0-B5B4-2D72E54EAAA4}';
    +  FOLDERID_SavedPictures           : TGUID = '{3B193882-D3AD-4EAB-965A-69829D1FB59F}';
    +  FOLDERID_SavedPicturesLibrary    : TGUID = '{E25B5812-BE88-4BD9-94B0-29233477B6C3}';
    +  FOLDERID_SavedSearches           : TGUID = '{7D1D3A04-DEBB-4115-95CF-2F29DA2920DA}';
    +  FOLDERID_Screenshots             : TGUID = '{B7BEDE81-DF94-4682-A7D8-57A52620B86F}';
    +  FOLDERID_SearchHistory           : TGUID = '{0D4C3DB6-03A3-462F-A0E6-08924C41B5D4}';
    +  FOLDERID_SearchHome              : TGUID = '{190337D1-B8CA-4121-A639-6D472D16972A}';
    +  FOLDERID_SearchTemplates         : TGUID = '{7E636BFE-DFA9-4D5E-B456-D7B39851D8A9}';
    +  FOLDERID_SendTo                  : TGUID = '{8983036C-27C0-404B-8F08-102D10DCFD74}';
    +  FOLDERID_SidebarDefaultParts     : TGUID = '{7B396E54-9EC5-4300-BE0A-2482EBAE1A26}';
    +  FOLDERID_SidebarParts            : TGUID = '{A75D362E-50FC-4FB7-AC2C-A8BEAA314493}';
    +  FOLDERID_SkyDrive                : TGUID = '{A52BBA46-E9E1-435F-B3D9-28DAA648C0F6}';
    +  FOLDERID_SkyDriveCameraRoll      : TGUID = '{767E6811-49CB-4273-87C2-20F355E1085B}';
    +  FOLDERID_SkyDriveDocuments       : TGUID = '{24D89E24-2F19-4534-9DDE-6A6671FBB8FE}';
    +  FOLDERID_SkyDriveMusic           : TGUID = '{C3F2459E-80D6-45DC-BFEF-1F769F2BE730}';
    +  FOLDERID_SkyDrivePictures        : TGUID = '{339719B5-8C47-4894-94C2-D8F77ADD44A6}';
    +  FOLDERID_StartMenu               : TGUID = '{625B53C3-AB48-4EC1-BA1F-A1EF4146FC19}';
    +  FOLDERID_StartMenuAllPrograms    : TGUID = '{F26305EF-6948-40B9-B255-81453D09C785}';
    +  FOLDERID_Startup                 : TGUID = '{B97D20BB-F46A-4C97-BA10-5E3608430854}';
    +  FOLDERID_SyncManagerFolder       : TGUID = '{43668BF8-C14E-49B2-97C9-747784D784B7}';
    +  FOLDERID_SyncResultsFolder       : TGUID = '{289A9A43-BE44-4057-A41B-587A76D7E7F9}';
    +  FOLDERID_SyncSetupFolder         : TGUID = '{0F214138-B1D3-4A90-BBA9-27CBC0C5389A}';
    +  FOLDERID_System                  : TGUID = '{1AC14E77-02E7-4E5D-B744-2EB1AE5198B7}';
    +  FOLDERID_SystemX86               : TGUID = '{D65231B0-B2F1-4857-A4CE-A8E7C6EA7D27}';
    +  FOLDERID_Templates               : TGUID = '{A63293E8-664E-48DB-A079-DF759E0509F7}';
    +  FOLDERID_UserPinned              : TGUID = '{9E3995AB-1F9C-4F13-B827-48B24B6C7174}';
    +  FOLDERID_UserProfiles            : TGUID = '{0762D272-C50A-4BB0-A382-697DCD729B80}';
    +  FOLDERID_UserProgramFiles        : TGUID = '{5CD7AEE2-2219-4A67-B85D-6C9CE15660CB}';
    +  FOLDERID_UserProgramFilesCommon  : TGUID = '{BCBD3057-CA5C-4622-B42D-BC56DB0AE516}';
    +  FOLDERID_UsersFiles              : TGUID = '{F3CE0F7C-4901-4ACC-8648-D5D44B04EF8F}';
    +  FOLDERID_UsersLibraries          : TGUID = '{A302545D-DEFF-464B-ABE8-61C8648D939B}';
    +  FOLDERID_Videos                  : TGUID = '{18989B1D-99B5-455B-841C-AB7C74E4DDFC}';
    +  FOLDERID_VideosLibrary           : TGUID = '{491E922F-5643-4AF4-A7EB-4E7A138D8174}';
    +  FOLDERID_Windows                 : TGUID = '{F38BF404-1D43-42F2-9305-67DE0B28FC23}';
     
    +// KNOWN_FOLDER_FLAG enumeration
    +const
    +  KF_FLAG_DEFAULT = DWORD(0);
    +  KF_FLAG_CREATE  = DWORD($8000);
    +
     function GetWindowsSpecialDir(ID: Integer; CreateIfNotExists: Boolean = True): String;
    +function GetWindowsSpecialDir(const GUID: TGUID; CreateIfNotExists: Boolean = True): String;
     function GetWindowsSpecialDirUnicode(ID: Integer; CreateIfNotExists: Boolean = True): UnicodeString;
    +function GetWindowsSpecialDirUnicode(const GUID: TGUID; CreateIfNotExists: Boolean = True): UnicodeString;
     
     function GetWindowsSystemDirectory: String;
     function GetWindowsSystemDirectoryUnicode: UnicodeString;
     
    +function ConvertCSIDLtoFOLDERID(CSIDL: Integer; out FOLDERID: TGUID): Boolean;
    +function ConvertFOLDERIDtoCSIDL(const FOLDERID: TGUID; out CSIDL: Integer): Boolean;
    +
     implementation
     
     uses
    -  sysutils;
    +  Windows, SysUtils;
     
     type
    +  TCSIDLtoFOLDERID = record
    +    CSIDL: Integer;
    +    FOLDERID: PGUID;
    +  end;
    +
    +const
    +  // Mapping of legacy CSIDL_* constants to their appropriate FOLDERID_* counterparts.
    +  CSIDLtoFOLDERID: array [1..40] of TCSIDLtoFOLDERID = (
    +    (CSIDL: CSIDL_PROGRAMS;                 FOLDERID: @FOLDERID_Programs),
    +    (CSIDL: CSIDL_PERSONAL;                 FOLDERID: @FOLDERID_Documents),
    +    (CSIDL: CSIDL_FAVORITES;                FOLDERID: @FOLDERID_Favorites),
    +    (CSIDL: CSIDL_STARTUP;                  FOLDERID: @FOLDERID_Startup),
    +    (CSIDL: CSIDL_RECENT;                   FOLDERID: @FOLDERID_Recent),
    +    (CSIDL: CSIDL_SENDTO;                   FOLDERID: @FOLDERID_SendTo),
    +    (CSIDL: CSIDL_STARTMENU;                FOLDERID: @FOLDERID_StartMenu),
    +    (CSIDL: CSIDL_MYMUSIC;                  FOLDERID: @FOLDERID_Music),
    +    (CSIDL: CSIDL_MYVIDEO;                  FOLDERID: @FOLDERID_Videos),
    +    (CSIDL: CSIDL_DESKTOPDIRECTORY;         FOLDERID: @FOLDERID_Desktop),
    +    (CSIDL: CSIDL_NETHOOD;                  FOLDERID: @FOLDERID_NetHood),
    +    (CSIDL: CSIDL_FONTS;                    FOLDERID: @FOLDERID_Fonts),
    +    (CSIDL: CSIDL_TEMPLATES;                FOLDERID: @FOLDERID_Templates),
    +    (CSIDL: CSIDL_COMMON_STARTMENU;         FOLDERID: @FOLDERID_CommonStartMenu),
    +    (CSIDL: CSIDL_COMMON_PROGRAMS;          FOLDERID: @FOLDERID_CommonPrograms),
    +    (CSIDL: CSIDL_COMMON_STARTUP;           FOLDERID: @FOLDERID_CommonStartup),
    +    (CSIDL: CSIDL_COMMON_DESKTOPDIRECTORY;  FOLDERID: @FOLDERID_PublicDesktop),
    +    (CSIDL: CSIDL_APPDATA;                  FOLDERID: @FOLDERID_RoamingAppData),
    +    (CSIDL: CSIDL_PRINTHOOD;                FOLDERID: @FOLDERID_PrintHood),
    +    (CSIDL: CSIDL_LOCAL_APPDATA;            FOLDERID: @FOLDERID_LocalAppData),
    +    (CSIDL: CSIDL_COMMON_FAVORITES;         FOLDERID: @FOLDERID_Favorites),
    +    (CSIDL: CSIDL_INTERNET_CACHE;           FOLDERID: @FOLDERID_InternetCache),
    +    (CSIDL: CSIDL_COOKIES;                  FOLDERID: @FOLDERID_Cookies),
    +    (CSIDL: CSIDL_HISTORY;                  FOLDERID: @FOLDERID_History),
    +    (CSIDL: CSIDL_COMMON_APPDATA;           FOLDERID: @FOLDERID_ProgramData),
    +    (CSIDL: CSIDL_WINDOWS;                  FOLDERID: @FOLDERID_Windows),
    +    (CSIDL: CSIDL_SYSTEM;                   FOLDERID: @FOLDERID_System),
    +    (CSIDL: CSIDL_PROGRAM_FILES;            FOLDERID: @FOLDERID_ProgramFiles),
    +    (CSIDL: CSIDL_MYPICTURES;               FOLDERID: @FOLDERID_Pictures),
    +    (CSIDL: CSIDL_PROFILE;                  FOLDERID: @FOLDERID_Profile),
    +    (CSIDL: CSIDL_PROGRAM_FILES_COMMON;     FOLDERID: @FOLDERID_ProgramFilesCommon),
    +    (CSIDL: CSIDL_COMMON_TEMPLATES;         FOLDERID: @FOLDERID_CommonTemplates),
    +    (CSIDL: CSIDL_COMMON_DOCUMENTS;         FOLDERID: @FOLDERID_PublicDocuments),
    +    (CSIDL: CSIDL_COMMON_ADMINTOOLS;        FOLDERID: @FOLDERID_CommonAdminTools),
    +    (CSIDL: CSIDL_ADMINTOOLS;               FOLDERID: @FOLDERID_AdminTools),
    +    (CSIDL: CSIDL_COMMON_MUSIC;             FOLDERID: @FOLDERID_PublicMusic),
    +    (CSIDL: CSIDL_COMMON_PICTURES;          FOLDERID: @FOLDERID_PublicPictures),
    +    (CSIDL: CSIDL_COMMON_VIDEO;             FOLDERID: @FOLDERID_PublicVideos),
    +    (CSIDL: CSIDL_CDBURN_AREA;              FOLDERID: @FOLDERID_CDBurning),
    +    (CSIDL: CSIDL_PROFILES;                 FOLDERID: @FOLDERID_UserProfiles)
    +  );
    +
    +// CoTaskMemFree is required for the use of SHGetKnownFolderPath function.
    +// CoTaskMemFree function signature was copied from ActiveX unit.
    +procedure CoTaskMemFree(_para1:PVOID); stdcall; external 'ole32.dll' name 'CoTaskMemFree';
    +
    +type
    +  KNOWNFOLDERID = TGUID;
    +  PWSTR = PWideChar;
    +
    +type
       // HRESULT SHGetFolderPath(
       //  _In_  HWND   hwndOwner,
       //  _In_  int    nFolder,
    @@ -85,15 +303,30 @@
       //  _In_  DWORD  dwFlags,
       //  _Out_ LPTSTR pszPath
       // );
    +  // DLL: Shell32.dll (version 5.0 or later)
    +  // OS: Windows 2000 and newer
       TSHGetFolderPathW = function(Ahwnd: HWND; Csidl: Integer; Token: THandle;
         Flags: DWORD; Path: PWideChar): HRESULT; stdcall;
     
    +  // HRESULT SHGetKnownFolderPath(
    +  //  _In_     REFKNOWNFOLDERID rfid,
    +  //  _In_     DWORD            dwFlags,
    +  //  _In_opt_ HANDLE           hToken,
    +  //  _Out_    PWSTR            *ppszPath
    +  // );
    +  // DLL: Shell32.dll (version 6.0.6000 or later)
    +  // OS: Windows Vista / Server 2008 and newer
    +  TSHGetKnownFolderPathW = function(const rfid: KNOWNFOLDERID; dwFlags: DWORD;
    +    hToken: THandle; out ppszPath: PWSTR): HRESULT; stdcall;
    +
     const
       SSHGetFolderPathW = 'SHGetFolderPathW';
    +  SSHGetKnownFolderPathW = 'SHGetKnownFolderPath';
       SLibName = 'shell32.dll';
     
     var
       _SHGetFolderPathW : TSHGetFolderPathW = nil;
    +  _SHGetKnownFolderPathW: TSHGetKnownFolderPathW = nil;
       DLLHandle: THandle = 0;
     
     procedure InitDLL;
    @@ -109,11 +342,15 @@
           DLLPath := IncludeTrailingPathDelimiter(DLLPath) + SLibName;
           DLLHandle := LoadLibraryW(PWideChar(DLLPath));
           if DLLHandle <> 0 then
    +      begin
             Pointer(_SHGetFolderPathW) := GetProcAddress(DLLHandle, SSHGetFolderPathW);
    +        Pointer(_SHGetKnownFolderPathW) := GetProcAddress(DLLHandle, SSHGetKnownFolderPathW);
    +      end;
         end;
       end;
    -  if @_SHGetFolderPathW = nil then
    -    raise Exception.Create('Could not locate SHGetFolderPath function');
    +  // At least one of SHGetFolderPath or SHGetKnownFolderPath functions is required
    +  if (@_SHGetFolderPathW = nil) and (@_SHGetKnownFolderPathW = nil) then
    +    raise Exception.Create('Could not locate '+SSHGetFolderPathW+' / '+SSHGetKnownFolderPathW+' functions');
     end;
     
     procedure FinitDLL;
    @@ -147,20 +384,101 @@
     function GetWindowsSpecialDirUnicode(ID: Integer; CreateIfNotExists: Boolean = True): UnicodeString;
     var
       Buffer: array [0..MAX_PATH] of WideChar;
    +  FOLDERID: TGUID;
     begin
       InitDLL;
       Result := '';
    -  if CreateIfNotExists then
    -    ID := ID or CSIDL_FLAG_CREATE;
    -  if _SHGetFolderPathW(0, ID, 0, 0, @Buffer[0]) = S_OK then
    -    Result := IncludeTrailingPathDelimiter(StrPas(Buffer));
    +  if @_SHGetFolderPathW = nil then
    +  begin
    +    if ConvertCSIDLtoFOLDERID(ID, FOLDERID) then
    +      Result := GetWindowsSpecialDirUnicode(FOLDERID, CreateIfNotExists);
    +  end
    +  else
    +  begin
    +    if CreateIfNotExists then
    +      ID := ID or CSIDL_FLAG_CREATE;
    +    if _SHGetFolderPathW(0, ID, 0, 0, @Buffer[0]) = S_OK then
    +      Result := IncludeTrailingPathDelimiter(StrPas(Buffer));
    +  end;
     end;
     
    +function GetWindowsSpecialDirUnicode(const GUID: TGUID; CreateIfNotExists: Boolean = True): UnicodeString;
    +var
    +  Flags: DWORD;
    +  Path: PWSTR;
    +  CSIDL: Integer;
    +begin
    +  InitDLL;
    +  Result := '';
    +  if @_SHGetKnownFolderPathW = nil then
    +  begin
    +    if ConvertFOLDERIDtoCSIDL(GUID, CSIDL) then
    +      Result := GetWindowsSpecialDirUnicode(CSIDL, CreateIfNotExists);
    +  end
    +  else
    +  begin
    +    Path := nil;
    +    Flags := KF_FLAG_DEFAULT;
    +    if CreateIfNotExists then
    +      Flags := Flags or KF_FLAG_CREATE;
    +    if _SHGetKnownFolderPathW(GUID, Flags, 0, Path) = S_OK then
    +    begin
    +      Result := StrPas(Path);
    +      CoTaskMemFree(Path);
    +    end;
    +  end;
    +end;
    +
     function GetWindowsSpecialDir(ID: Integer; CreateIfNotExists: Boolean = True): String;
     begin
       Result := String(GetWindowsSpecialDirUnicode(ID, CreateIfNotExists));
     end;
     
    +function GetWindowsSpecialDir(const GUID: TGUID; CreateIfNotExists: Boolean = True): String;
    +begin
    +  Result := String(GetWindowsSpecialDirUnicode(GUID, CreateIfNotExists));
    +end;
    +
    +function ConvertCSIDLtoFOLDERID(CSIDL: Integer; out FOLDERID: TGUID): Boolean;
    +var
    +  I: Integer;
    +begin
    +  Result := False;
    +  for I := Low(CSIDLtoFOLDERID) to High(CSIDLtoFOLDERID) do
    +  begin
    +    if CSIDLtoFOLDERID[I].CSIDL = CSIDL then
    +    begin
    +      if CSIDLtoFOLDERID[I].FOLDERID <> nil then
    +      begin
    +        FOLDERID := CSIDLtoFOLDERID[I].FOLDERID^;
    +        Result := True;
    +        Break;
    +      end
    +      else
    +        Break;
    +    end;
    +  end;
    +end;
    +
    +function ConvertFOLDERIDtoCSIDL(const FOLDERID: TGUID; out CSIDL: Integer): Boolean;
    +var
    +  I: Integer;
    +begin
    +  Result := False;
    +  for I := Low(CSIDLtoFOLDERID) to High(CSIDLtoFOLDERID) do
    +  begin
    +    if CSIDLtoFOLDERID[I].FOLDERID <> nil then
    +    begin
    +      if IsEqualGUID(CSIDLtoFOLDERID[I].FOLDERID^, FOLDERID) then
    +      begin
    +        CSIDL := CSIDLtoFOLDERID[I].CSIDL;
    +        Result := True;
    +        Break;
    +      end;
    +    end;
    +  end;
    +end;
    +
     finalization
       FinitDLL;
     
    
    windirs.pp.patch (24,331 bytes)

Activities

Denis Kozlov

2018-02-06 03:19

reporter  

windirs.pp.patch (24,331 bytes)
Index: rtl/win/windirs.pp
===================================================================
--- rtl/win/windirs.pp	(revision 38125)
+++ rtl/win/windirs.pp	(working copy)
@@ -11,6 +11,10 @@
 is called. New applications should use the known folder system rather than the older
 CSIDL system, which is supported only for backward compatibility.
 
+Official list of CSIDL and FOLDERID constants:
+https://msdn.microsoft.com/en-us/library/windows/desktop/bb762494.aspx
+https://msdn.microsoft.com/en-us/library/windows/desktop/dd378457.aspx
+
 *******************************************************************************}
 
 {$mode objfpc}
@@ -18,10 +22,8 @@
 
 interface
 
-uses
-  windows;
-
 // CSIDL_* contants are also declared in "ShellApi" and "shfolder" units.
+// If changed, remember to add an appropriate mapping in CSIDLtoFOLDERID list.
 const
   CSIDL_PROGRAMS                = $0002; { %SYSTEMDRIVE%\Program Files                                      }
   CSIDL_PERSONAL                = $0005; { %USERPROFILE%\My Documents                                       }
@@ -34,6 +36,7 @@
   CSIDL_MYVIDEO                 = $000E; { %USERPROFILE%\Documents\My Videos                                }
   CSIDL_DESKTOPDIRECTORY        = $0010; { %USERPROFILE%\Desktop                                            }
   CSIDL_NETHOOD                 = $0013; { %USERPROFILE%\NetHood                                            }
+  CSIDL_FONTS                   = $0014; { %SYSTEMROOT%\Fonts                                               }
   CSIDL_TEMPLATES               = $0015; { %USERPROFILE%\Templates                                          }
   CSIDL_COMMON_STARTMENU        = $0016; { %PROFILEPATH%\All users\Start menu                               }
   CSIDL_COMMON_PROGRAMS         = $0017; { %PROFILEPATH%\All users\Start menu\Programs                      }
@@ -62,22 +65,237 @@
   CSIDL_COMMON_VIDEO            = $0037; { %PROFILEPATH%\All Users\Documents\my videos                      }
   CSIDL_CDBURN_AREA             = $003B; { %USERPROFILE%\Local Settings\Application Data\Microsoft\CD Burning }
   CSIDL_PROFILES                = $003E; { %PROFILEPATH%                                                    }
+  // NOTE: CSIDL_PROFILES has been removed from Microsoft official documentation!
 
   CSIDL_FLAG_CREATE             = $8000; { (force creation of requested folder if it doesn't exist yet)     }
 
+// FOLDERID_* constants parsed from KnownFolders.h file in
+// Windows 10 SDK for Fall Creators Update (10.0.16299.91).
+// If changed, remember to add an appropriate mapping in CSIDLtoFOLDERID list.
+const
+  FOLDERID_AccountPictures         : TGUID = '{008CA0B1-55B4-4C56-B8A8-4DE4B299D3BE}';
+  FOLDERID_AddNewPrograms          : TGUID = '{DE61D971-5EBC-4F02-A3A9-6C82895E5C04}';
+  FOLDERID_AdminTools              : TGUID = '{724EF170-A42D-4FEF-9F26-B60E846FBA4F}';
+  FOLDERID_AllAppMods              : TGUID = '{7AD67899-66AF-43BA-9156-6AAD42E6C596}';
+  FOLDERID_AppCaptures             : TGUID = '{EDC0FE71-98D8-4F4A-B920-C8DC133CB165}';
+  FOLDERID_AppDataDesktop          : TGUID = '{B2C5E279-7ADD-439F-B28C-C41FE1BBF672}';
+  FOLDERID_AppDataDocuments        : TGUID = '{7BE16610-1F7F-44AC-BFF0-83E15F2FFCA1}';
+  FOLDERID_AppDataFavorites        : TGUID = '{7CFBEFBC-DE1F-45AA-B843-A542AC536CC9}';
+  FOLDERID_AppDataProgramData      : TGUID = '{559D40A3-A036-40FA-AF61-84CB430A4D34}';
+  FOLDERID_AppUpdates              : TGUID = '{A305CE99-F527-492B-8B1A-7E76FA98D6E4}';
+  FOLDERID_ApplicationShortcuts    : TGUID = '{A3918781-E5F2-4890-B3D9-A7E54332328C}';
+  FOLDERID_AppsFolder              : TGUID = '{1E87508D-89C2-42F0-8A7E-645A0F50CA58}';
+  FOLDERID_CDBurning               : TGUID = '{9E52AB10-F80D-49DF-ACB8-4330F5687855}';
+  FOLDERID_CameraRoll              : TGUID = '{AB5FB87B-7CE2-4F83-915D-550846C9537B}';
+  FOLDERID_CameraRollLibrary       : TGUID = '{2B20DF75-1EDA-4039-8097-38798227D5B7}';
+  FOLDERID_ChangeRemovePrograms    : TGUID = '{DF7266AC-9274-4867-8D55-3BD661DE872D}';
+  FOLDERID_CommonAdminTools        : TGUID = '{D0384E7D-BAC3-4797-8F14-CBA229B392B5}';
+  FOLDERID_CommonOEMLinks          : TGUID = '{C1BAE2D0-10DF-4334-BEDD-7AA20B227A9D}';
+  FOLDERID_CommonPrograms          : TGUID = '{0139D44E-6AFE-49F2-8690-3DAFCAE6FFB8}';
+  FOLDERID_CommonStartMenu         : TGUID = '{A4115719-D62E-491D-AA7C-E74B8BE3B067}';
+  FOLDERID_CommonStartMenuPlaces   : TGUID = '{A440879F-87A0-4F7D-B700-0207B966194A}';
+  FOLDERID_CommonStartup           : TGUID = '{82A5EA35-D9CD-47C5-9629-E15D2F714E6E}';
+  FOLDERID_CommonTemplates         : TGUID = '{B94237E7-57AC-4347-9151-B08C6C32D1F7}';
+  FOLDERID_ComputerFolder          : TGUID = '{0AC0837C-BBF8-452A-850D-79D08E667CA7}';
+  FOLDERID_ConflictFolder          : TGUID = '{4BFEFB45-347D-4006-A5BE-AC0CB0567192}';
+  FOLDERID_ConnectionsFolder       : TGUID = '{6F0CD92B-2E97-45D1-88FF-B0D186B8DEDD}';
+  FOLDERID_Contacts                : TGUID = '{56784854-C6CB-462B-8169-88E350ACB882}';
+  FOLDERID_ControlPanelFolder      : TGUID = '{82A74AEB-AEB4-465C-A014-D097EE346D63}';
+  FOLDERID_Cookies                 : TGUID = '{2B0F765D-C0E9-4171-908E-08A611B84FF6}';
+  FOLDERID_CurrentAppMods          : TGUID = '{3DB40B20-2A30-4DBE-917E-771DD21DD099}';
+  FOLDERID_Desktop                 : TGUID = '{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}';
+  FOLDERID_DevelopmentFiles        : TGUID = '{DBE8E08E-3053-4BBC-B183-2A7B2B191E59}';
+  FOLDERID_Device                  : TGUID = '{1C2AC1DC-4358-4B6C-9733-AF21156576F0}';
+  FOLDERID_DeviceMetadataStore     : TGUID = '{5CE4A5E9-E4EB-479D-B89F-130C02886155}';
+  FOLDERID_Documents               : TGUID = '{FDD39AD0-238F-46AF-ADB4-6C85480369C7}';
+  FOLDERID_DocumentsLibrary        : TGUID = '{7B0DB17D-9CD2-4A93-9733-46CC89022E7C}';
+  FOLDERID_Downloads               : TGUID = '{374DE290-123F-4565-9164-39C4925E467B}';
+  FOLDERID_Favorites               : TGUID = '{1777F761-68AD-4D8A-87BD-30B759FA33DD}';
+  FOLDERID_Fonts                   : TGUID = '{FD228CB7-AE11-4AE3-864C-16F3910AB8FE}';
+  FOLDERID_GameTasks               : TGUID = '{054FAE61-4DD8-4787-80B6-090220C4B700}';
+  FOLDERID_Games                   : TGUID = '{CAC52C1A-B53D-4EDC-92D7-6B2E8AC19434}';
+  FOLDERID_History                 : TGUID = '{D9DC8A3B-B784-432E-A781-5A1130A75963}';
+  FOLDERID_HomeGroup               : TGUID = '{52528A6B-B9E3-4ADD-B60D-588C2DBA842D}';
+  FOLDERID_HomeGroupCurrentUser    : TGUID = '{9B74B6A3-0DFD-4F11-9E78-5F7800F2E772}';
+  FOLDERID_ImplicitAppShortcuts    : TGUID = '{BCB5256F-79F6-4CEE-B725-DC34E402FD46}';
+  FOLDERID_InternetCache           : TGUID = '{352481E8-33BE-4251-BA85-6007CAEDCF9D}';
+  FOLDERID_InternetFolder          : TGUID = '{4D9F7874-4E0C-4904-967B-40B0D20C3E4B}';
+  FOLDERID_Libraries               : TGUID = '{1B3EA5DC-B587-4786-B4EF-BD1DC332AEAE}';
+  FOLDERID_Links                   : TGUID = '{BFB9D5E0-C6A9-404C-B2B2-AE6DB6AF4968}';
+  FOLDERID_LocalAppData            : TGUID = '{F1B32785-6FBA-4FCF-9D55-7B8E7F157091}';
+  FOLDERID_LocalAppDataLow         : TGUID = '{A520A1A4-1780-4FF6-BD18-167343C5AF16}';
+  FOLDERID_LocalDocuments          : TGUID = '{F42EE2D3-909F-4907-8871-4C22FC0BF756}';
+  FOLDERID_LocalDownloads          : TGUID = '{7D83EE9B-2244-4E70-B1F5-5393042AF1E4}';
+  FOLDERID_LocalMusic              : TGUID = '{A0C69A99-21C8-4671-8703-7934162FCF1D}';
+  FOLDERID_LocalPictures           : TGUID = '{0DDD015D-B06C-45D5-8C4C-F59713854639}';
+  FOLDERID_LocalVideos             : TGUID = '{35286A68-3C57-41A1-BBB1-0EAE73D76C95}';
+  FOLDERID_LocalizedResourcesDir   : TGUID = '{2A00375E-224C-49DE-B8D1-440DF7EF3DDC}';
+  FOLDERID_Music                   : TGUID = '{4BD8D571-6D19-48D3-BE97-422220080E43}';
+  FOLDERID_MusicLibrary            : TGUID = '{2112AB0A-C86A-4FFE-A368-0DE96E47012E}';
+  FOLDERID_NetHood                 : TGUID = '{C5ABBF53-E17F-4121-8900-86626FC2C973}';
+  FOLDERID_NetworkFolder           : TGUID = '{D20BEEC4-5CA8-4905-AE3B-BF251EA09B53}';
+  FOLDERID_Objects3D               : TGUID = '{31C0DD25-9439-4F12-BF41-7FF4EDA38722}';
+  FOLDERID_OneDrive                : TGUID = '{A52BBA46-E9E1-435F-B3D9-28DAA648C0F6}';
+  FOLDERID_OriginalImages          : TGUID = '{2C36C0AA-5812-4B87-BFD0-4CD0DFB19B39}';
+  FOLDERID_PhotoAlbums             : TGUID = '{69D2CF90-FC33-4FB7-9A0C-EBB0F0FCB43C}';
+  FOLDERID_Pictures                : TGUID = '{33E28130-4E1E-4676-835A-98395C3BC3BB}';
+  FOLDERID_PicturesLibrary         : TGUID = '{A990AE9F-A03B-4E80-94BC-9912D7504104}';
+  FOLDERID_Playlists               : TGUID = '{DE92C1C7-837F-4F69-A3BB-86E631204A23}';
+  FOLDERID_PrintHood               : TGUID = '{9274BD8D-CFD1-41C3-B35E-B13F55A758F4}';
+  FOLDERID_PrintersFolder          : TGUID = '{76FC4E2D-D6AD-4519-A663-37BD56068185}';
+  FOLDERID_Profile                 : TGUID = '{5E6C858F-0E22-4760-9AFE-EA3317B67173}';
+  FOLDERID_ProgramData             : TGUID = '{62AB5D82-FDC1-4DC3-A9DD-070D1D495D97}';
+  FOLDERID_ProgramFiles            : TGUID = '{905E63B6-C1BF-494E-B29C-65B732D3D21A}';
+  FOLDERID_ProgramFilesCommon      : TGUID = '{F7F1ED05-9F6D-47A2-AAAE-29D317C6F066}';
+  FOLDERID_ProgramFilesCommonX64   : TGUID = '{6365D5A7-0F0D-45E5-87F6-0DA56B6A4F7D}';
+  FOLDERID_ProgramFilesCommonX86   : TGUID = '{DE974D24-D9C6-4D3E-BF91-F4455120B917}';
+  FOLDERID_ProgramFilesX64         : TGUID = '{6D809377-6AF0-444B-8957-A3773F02200E}';
+  FOLDERID_ProgramFilesX86         : TGUID = '{7C5A40EF-A0FB-4BFC-874A-C0F2E0B9FA8E}';
+  FOLDERID_Programs                : TGUID = '{A77F5D77-2E2B-44C3-A6A2-ABA601054A51}';
+  FOLDERID_Public                  : TGUID = '{DFDF76A2-C82A-4D63-906A-5644AC457385}';
+  FOLDERID_PublicDesktop           : TGUID = '{C4AA340D-F20F-4863-AFEF-F87EF2E6BA25}';
+  FOLDERID_PublicDocuments         : TGUID = '{ED4824AF-DCE4-45A8-81E2-FC7965083634}';
+  FOLDERID_PublicDownloads         : TGUID = '{3D644C9B-1FB8-4F30-9B45-F670235F79C0}';
+  FOLDERID_PublicGameTasks         : TGUID = '{DEBF2536-E1A8-4C59-B6A2-414586476AEA}';
+  FOLDERID_PublicLibraries         : TGUID = '{48DAF80B-E6CF-4F4E-B800-0E69D84EE384}';
+  FOLDERID_PublicMusic             : TGUID = '{3214FAB5-9757-4298-BB61-92A9DEAA44FF}';
+  FOLDERID_PublicPictures          : TGUID = '{B6EBFB86-6907-413C-9AF7-4FC2ABF07CC5}';
+  FOLDERID_PublicRingtones         : TGUID = '{E555AB60-153B-4D17-9F04-A5FE99FC15EC}';
+  FOLDERID_PublicUserTiles         : TGUID = '{0482AF6C-08F1-4C34-8C90-E17EC98B1E17}';
+  FOLDERID_PublicVideos            : TGUID = '{2400183A-6185-49FB-A2D8-4A392A602BA3}';
+  FOLDERID_QuickLaunch             : TGUID = '{52A4F021-7B75-48A9-9F6B-4B87A210BC8F}';
+  FOLDERID_Recent                  : TGUID = '{AE50C081-EBD2-438A-8655-8A092E34987A}';
+  FOLDERID_RecordedCalls           : TGUID = '{2F8B40C2-83ED-48EE-B383-A1F157EC6F9A}';
+  FOLDERID_RecordedTVLibrary       : TGUID = '{1A6FDBA2-F42D-4358-A798-B74D745926C5}';
+  FOLDERID_RecycleBinFolder        : TGUID = '{B7534046-3ECB-4C18-BE4E-64CD4CB7D6AC}';
+  FOLDERID_ResourceDir             : TGUID = '{8AD10C31-2ADB-4296-A8F7-E4701232C972}';
+  FOLDERID_RetailDemo              : TGUID = '{12D4C69E-24AD-4923-BE19-31321C43A767}';
+  FOLDERID_Ringtones               : TGUID = '{C870044B-F49E-4126-A9C3-B52A1FF411E8}';
+  FOLDERID_RoamedTileImages        : TGUID = '{AAA8D5A5-F1D6-4259-BAA8-78E7EF60835E}';
+  FOLDERID_RoamingAppData          : TGUID = '{3EB685DB-65F9-4CF6-A03A-E3EF65729F3D}';
+  FOLDERID_RoamingTiles            : TGUID = '{00BCFC5A-ED94-4E48-96A1-3F6217F21990}';
+  FOLDERID_SEARCH_CSC              : TGUID = '{EE32E446-31CA-4ABA-814F-A5EBD2FD6D5E}';
+  FOLDERID_SEARCH_MAPI             : TGUID = '{98EC0E18-2098-4D44-8644-66979315A281}';
+  FOLDERID_SampleMusic             : TGUID = '{B250C668-F57D-4EE1-A63C-290EE7D1AA1F}';
+  FOLDERID_SamplePictures          : TGUID = '{C4900540-2379-4C75-844B-64E6FAF8716B}';
+  FOLDERID_SamplePlaylists         : TGUID = '{15CA69B3-30EE-49C1-ACE1-6B5EC372AFB5}';
+  FOLDERID_SampleVideos            : TGUID = '{859EAD94-2E85-48AD-A71A-0969CB56A6CD}';
+  FOLDERID_SavedGames              : TGUID = '{4C5C32FF-BB9D-43B0-B5B4-2D72E54EAAA4}';
+  FOLDERID_SavedPictures           : TGUID = '{3B193882-D3AD-4EAB-965A-69829D1FB59F}';
+  FOLDERID_SavedPicturesLibrary    : TGUID = '{E25B5812-BE88-4BD9-94B0-29233477B6C3}';
+  FOLDERID_SavedSearches           : TGUID = '{7D1D3A04-DEBB-4115-95CF-2F29DA2920DA}';
+  FOLDERID_Screenshots             : TGUID = '{B7BEDE81-DF94-4682-A7D8-57A52620B86F}';
+  FOLDERID_SearchHistory           : TGUID = '{0D4C3DB6-03A3-462F-A0E6-08924C41B5D4}';
+  FOLDERID_SearchHome              : TGUID = '{190337D1-B8CA-4121-A639-6D472D16972A}';
+  FOLDERID_SearchTemplates         : TGUID = '{7E636BFE-DFA9-4D5E-B456-D7B39851D8A9}';
+  FOLDERID_SendTo                  : TGUID = '{8983036C-27C0-404B-8F08-102D10DCFD74}';
+  FOLDERID_SidebarDefaultParts     : TGUID = '{7B396E54-9EC5-4300-BE0A-2482EBAE1A26}';
+  FOLDERID_SidebarParts            : TGUID = '{A75D362E-50FC-4FB7-AC2C-A8BEAA314493}';
+  FOLDERID_SkyDrive                : TGUID = '{A52BBA46-E9E1-435F-B3D9-28DAA648C0F6}';
+  FOLDERID_SkyDriveCameraRoll      : TGUID = '{767E6811-49CB-4273-87C2-20F355E1085B}';
+  FOLDERID_SkyDriveDocuments       : TGUID = '{24D89E24-2F19-4534-9DDE-6A6671FBB8FE}';
+  FOLDERID_SkyDriveMusic           : TGUID = '{C3F2459E-80D6-45DC-BFEF-1F769F2BE730}';
+  FOLDERID_SkyDrivePictures        : TGUID = '{339719B5-8C47-4894-94C2-D8F77ADD44A6}';
+  FOLDERID_StartMenu               : TGUID = '{625B53C3-AB48-4EC1-BA1F-A1EF4146FC19}';
+  FOLDERID_StartMenuAllPrograms    : TGUID = '{F26305EF-6948-40B9-B255-81453D09C785}';
+  FOLDERID_Startup                 : TGUID = '{B97D20BB-F46A-4C97-BA10-5E3608430854}';
+  FOLDERID_SyncManagerFolder       : TGUID = '{43668BF8-C14E-49B2-97C9-747784D784B7}';
+  FOLDERID_SyncResultsFolder       : TGUID = '{289A9A43-BE44-4057-A41B-587A76D7E7F9}';
+  FOLDERID_SyncSetupFolder         : TGUID = '{0F214138-B1D3-4A90-BBA9-27CBC0C5389A}';
+  FOLDERID_System                  : TGUID = '{1AC14E77-02E7-4E5D-B744-2EB1AE5198B7}';
+  FOLDERID_SystemX86               : TGUID = '{D65231B0-B2F1-4857-A4CE-A8E7C6EA7D27}';
+  FOLDERID_Templates               : TGUID = '{A63293E8-664E-48DB-A079-DF759E0509F7}';
+  FOLDERID_UserPinned              : TGUID = '{9E3995AB-1F9C-4F13-B827-48B24B6C7174}';
+  FOLDERID_UserProfiles            : TGUID = '{0762D272-C50A-4BB0-A382-697DCD729B80}';
+  FOLDERID_UserProgramFiles        : TGUID = '{5CD7AEE2-2219-4A67-B85D-6C9CE15660CB}';
+  FOLDERID_UserProgramFilesCommon  : TGUID = '{BCBD3057-CA5C-4622-B42D-BC56DB0AE516}';
+  FOLDERID_UsersFiles              : TGUID = '{F3CE0F7C-4901-4ACC-8648-D5D44B04EF8F}';
+  FOLDERID_UsersLibraries          : TGUID = '{A302545D-DEFF-464B-ABE8-61C8648D939B}';
+  FOLDERID_Videos                  : TGUID = '{18989B1D-99B5-455B-841C-AB7C74E4DDFC}';
+  FOLDERID_VideosLibrary           : TGUID = '{491E922F-5643-4AF4-A7EB-4E7A138D8174}';
+  FOLDERID_Windows                 : TGUID = '{F38BF404-1D43-42F2-9305-67DE0B28FC23}';
 
+// KNOWN_FOLDER_FLAG enumeration
+const
+  KF_FLAG_DEFAULT = DWORD(0);
+  KF_FLAG_CREATE  = DWORD($8000);
+
 function GetWindowsSpecialDir(ID: Integer; CreateIfNotExists: Boolean = True): String;
+function GetWindowsSpecialDir(const GUID: TGUID; CreateIfNotExists: Boolean = True): String;
 function GetWindowsSpecialDirUnicode(ID: Integer; CreateIfNotExists: Boolean = True): UnicodeString;
+function GetWindowsSpecialDirUnicode(const GUID: TGUID; CreateIfNotExists: Boolean = True): UnicodeString;
 
 function GetWindowsSystemDirectory: String;
 function GetWindowsSystemDirectoryUnicode: UnicodeString;
 
+function ConvertCSIDLtoFOLDERID(CSIDL: Integer; out FOLDERID: TGUID): Boolean;
+function ConvertFOLDERIDtoCSIDL(const FOLDERID: TGUID; out CSIDL: Integer): Boolean;
+
 implementation
 
 uses
-  sysutils;
+  Windows, SysUtils;
 
 type
+  TCSIDLtoFOLDERID = record
+    CSIDL: Integer;
+    FOLDERID: PGUID;
+  end;
+
+const
+  // Mapping of legacy CSIDL_* constants to their appropriate FOLDERID_* counterparts.
+  CSIDLtoFOLDERID: array [1..40] of TCSIDLtoFOLDERID = (
+    (CSIDL: CSIDL_PROGRAMS;                 FOLDERID: @FOLDERID_Programs),
+    (CSIDL: CSIDL_PERSONAL;                 FOLDERID: @FOLDERID_Documents),
+    (CSIDL: CSIDL_FAVORITES;                FOLDERID: @FOLDERID_Favorites),
+    (CSIDL: CSIDL_STARTUP;                  FOLDERID: @FOLDERID_Startup),
+    (CSIDL: CSIDL_RECENT;                   FOLDERID: @FOLDERID_Recent),
+    (CSIDL: CSIDL_SENDTO;                   FOLDERID: @FOLDERID_SendTo),
+    (CSIDL: CSIDL_STARTMENU;                FOLDERID: @FOLDERID_StartMenu),
+    (CSIDL: CSIDL_MYMUSIC;                  FOLDERID: @FOLDERID_Music),
+    (CSIDL: CSIDL_MYVIDEO;                  FOLDERID: @FOLDERID_Videos),
+    (CSIDL: CSIDL_DESKTOPDIRECTORY;         FOLDERID: @FOLDERID_Desktop),
+    (CSIDL: CSIDL_NETHOOD;                  FOLDERID: @FOLDERID_NetHood),
+    (CSIDL: CSIDL_FONTS;                    FOLDERID: @FOLDERID_Fonts),
+    (CSIDL: CSIDL_TEMPLATES;                FOLDERID: @FOLDERID_Templates),
+    (CSIDL: CSIDL_COMMON_STARTMENU;         FOLDERID: @FOLDERID_CommonStartMenu),
+    (CSIDL: CSIDL_COMMON_PROGRAMS;          FOLDERID: @FOLDERID_CommonPrograms),
+    (CSIDL: CSIDL_COMMON_STARTUP;           FOLDERID: @FOLDERID_CommonStartup),
+    (CSIDL: CSIDL_COMMON_DESKTOPDIRECTORY;  FOLDERID: @FOLDERID_PublicDesktop),
+    (CSIDL: CSIDL_APPDATA;                  FOLDERID: @FOLDERID_RoamingAppData),
+    (CSIDL: CSIDL_PRINTHOOD;                FOLDERID: @FOLDERID_PrintHood),
+    (CSIDL: CSIDL_LOCAL_APPDATA;            FOLDERID: @FOLDERID_LocalAppData),
+    (CSIDL: CSIDL_COMMON_FAVORITES;         FOLDERID: @FOLDERID_Favorites),
+    (CSIDL: CSIDL_INTERNET_CACHE;           FOLDERID: @FOLDERID_InternetCache),
+    (CSIDL: CSIDL_COOKIES;                  FOLDERID: @FOLDERID_Cookies),
+    (CSIDL: CSIDL_HISTORY;                  FOLDERID: @FOLDERID_History),
+    (CSIDL: CSIDL_COMMON_APPDATA;           FOLDERID: @FOLDERID_ProgramData),
+    (CSIDL: CSIDL_WINDOWS;                  FOLDERID: @FOLDERID_Windows),
+    (CSIDL: CSIDL_SYSTEM;                   FOLDERID: @FOLDERID_System),
+    (CSIDL: CSIDL_PROGRAM_FILES;            FOLDERID: @FOLDERID_ProgramFiles),
+    (CSIDL: CSIDL_MYPICTURES;               FOLDERID: @FOLDERID_Pictures),
+    (CSIDL: CSIDL_PROFILE;                  FOLDERID: @FOLDERID_Profile),
+    (CSIDL: CSIDL_PROGRAM_FILES_COMMON;     FOLDERID: @FOLDERID_ProgramFilesCommon),
+    (CSIDL: CSIDL_COMMON_TEMPLATES;         FOLDERID: @FOLDERID_CommonTemplates),
+    (CSIDL: CSIDL_COMMON_DOCUMENTS;         FOLDERID: @FOLDERID_PublicDocuments),
+    (CSIDL: CSIDL_COMMON_ADMINTOOLS;        FOLDERID: @FOLDERID_CommonAdminTools),
+    (CSIDL: CSIDL_ADMINTOOLS;               FOLDERID: @FOLDERID_AdminTools),
+    (CSIDL: CSIDL_COMMON_MUSIC;             FOLDERID: @FOLDERID_PublicMusic),
+    (CSIDL: CSIDL_COMMON_PICTURES;          FOLDERID: @FOLDERID_PublicPictures),
+    (CSIDL: CSIDL_COMMON_VIDEO;             FOLDERID: @FOLDERID_PublicVideos),
+    (CSIDL: CSIDL_CDBURN_AREA;              FOLDERID: @FOLDERID_CDBurning),
+    (CSIDL: CSIDL_PROFILES;                 FOLDERID: @FOLDERID_UserProfiles)
+  );
+
+// CoTaskMemFree is required for the use of SHGetKnownFolderPath function.
+// CoTaskMemFree function signature was copied from ActiveX unit.
+procedure CoTaskMemFree(_para1:PVOID); stdcall; external 'ole32.dll' name 'CoTaskMemFree';
+
+type
+  KNOWNFOLDERID = TGUID;
+  PWSTR = PWideChar;
+
+type
   // HRESULT SHGetFolderPath(
   //  _In_  HWND   hwndOwner,
   //  _In_  int    nFolder,
@@ -85,15 +303,30 @@
   //  _In_  DWORD  dwFlags,
   //  _Out_ LPTSTR pszPath
   // );
+  // DLL: Shell32.dll (version 5.0 or later)
+  // OS: Windows 2000 and newer
   TSHGetFolderPathW = function(Ahwnd: HWND; Csidl: Integer; Token: THandle;
     Flags: DWORD; Path: PWideChar): HRESULT; stdcall;
 
+  // HRESULT SHGetKnownFolderPath(
+  //  _In_     REFKNOWNFOLDERID rfid,
+  //  _In_     DWORD            dwFlags,
+  //  _In_opt_ HANDLE           hToken,
+  //  _Out_    PWSTR            *ppszPath
+  // );
+  // DLL: Shell32.dll (version 6.0.6000 or later)
+  // OS: Windows Vista / Server 2008 and newer
+  TSHGetKnownFolderPathW = function(const rfid: KNOWNFOLDERID; dwFlags: DWORD;
+    hToken: THandle; out ppszPath: PWSTR): HRESULT; stdcall;
+
 const
   SSHGetFolderPathW = 'SHGetFolderPathW';
+  SSHGetKnownFolderPathW = 'SHGetKnownFolderPath';
   SLibName = 'shell32.dll';
 
 var
   _SHGetFolderPathW : TSHGetFolderPathW = nil;
+  _SHGetKnownFolderPathW: TSHGetKnownFolderPathW = nil;
   DLLHandle: THandle = 0;
 
 procedure InitDLL;
@@ -109,11 +342,15 @@
       DLLPath := IncludeTrailingPathDelimiter(DLLPath) + SLibName;
       DLLHandle := LoadLibraryW(PWideChar(DLLPath));
       if DLLHandle <> 0 then
+      begin
         Pointer(_SHGetFolderPathW) := GetProcAddress(DLLHandle, SSHGetFolderPathW);
+        Pointer(_SHGetKnownFolderPathW) := GetProcAddress(DLLHandle, SSHGetKnownFolderPathW);
+      end;
     end;
   end;
-  if @_SHGetFolderPathW = nil then
-    raise Exception.Create('Could not locate SHGetFolderPath function');
+  // At least one of SHGetFolderPath or SHGetKnownFolderPath functions is required
+  if (@_SHGetFolderPathW = nil) and (@_SHGetKnownFolderPathW = nil) then
+    raise Exception.Create('Could not locate '+SSHGetFolderPathW+' / '+SSHGetKnownFolderPathW+' functions');
 end;
 
 procedure FinitDLL;
@@ -147,20 +384,101 @@
 function GetWindowsSpecialDirUnicode(ID: Integer; CreateIfNotExists: Boolean = True): UnicodeString;
 var
   Buffer: array [0..MAX_PATH] of WideChar;
+  FOLDERID: TGUID;
 begin
   InitDLL;
   Result := '';
-  if CreateIfNotExists then
-    ID := ID or CSIDL_FLAG_CREATE;
-  if _SHGetFolderPathW(0, ID, 0, 0, @Buffer[0]) = S_OK then
-    Result := IncludeTrailingPathDelimiter(StrPas(Buffer));
+  if @_SHGetFolderPathW = nil then
+  begin
+    if ConvertCSIDLtoFOLDERID(ID, FOLDERID) then
+      Result := GetWindowsSpecialDirUnicode(FOLDERID, CreateIfNotExists);
+  end
+  else
+  begin
+    if CreateIfNotExists then
+      ID := ID or CSIDL_FLAG_CREATE;
+    if _SHGetFolderPathW(0, ID, 0, 0, @Buffer[0]) = S_OK then
+      Result := IncludeTrailingPathDelimiter(StrPas(Buffer));
+  end;
 end;
 
+function GetWindowsSpecialDirUnicode(const GUID: TGUID; CreateIfNotExists: Boolean = True): UnicodeString;
+var
+  Flags: DWORD;
+  Path: PWSTR;
+  CSIDL: Integer;
+begin
+  InitDLL;
+  Result := '';
+  if @_SHGetKnownFolderPathW = nil then
+  begin
+    if ConvertFOLDERIDtoCSIDL(GUID, CSIDL) then
+      Result := GetWindowsSpecialDirUnicode(CSIDL, CreateIfNotExists);
+  end
+  else
+  begin
+    Path := nil;
+    Flags := KF_FLAG_DEFAULT;
+    if CreateIfNotExists then
+      Flags := Flags or KF_FLAG_CREATE;
+    if _SHGetKnownFolderPathW(GUID, Flags, 0, Path) = S_OK then
+    begin
+      Result := StrPas(Path);
+      CoTaskMemFree(Path);
+    end;
+  end;
+end;
+
 function GetWindowsSpecialDir(ID: Integer; CreateIfNotExists: Boolean = True): String;
 begin
   Result := String(GetWindowsSpecialDirUnicode(ID, CreateIfNotExists));
 end;
 
+function GetWindowsSpecialDir(const GUID: TGUID; CreateIfNotExists: Boolean = True): String;
+begin
+  Result := String(GetWindowsSpecialDirUnicode(GUID, CreateIfNotExists));
+end;
+
+function ConvertCSIDLtoFOLDERID(CSIDL: Integer; out FOLDERID: TGUID): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  for I := Low(CSIDLtoFOLDERID) to High(CSIDLtoFOLDERID) do
+  begin
+    if CSIDLtoFOLDERID[I].CSIDL = CSIDL then
+    begin
+      if CSIDLtoFOLDERID[I].FOLDERID <> nil then
+      begin
+        FOLDERID := CSIDLtoFOLDERID[I].FOLDERID^;
+        Result := True;
+        Break;
+      end
+      else
+        Break;
+    end;
+  end;
+end;
+
+function ConvertFOLDERIDtoCSIDL(const FOLDERID: TGUID; out CSIDL: Integer): Boolean;
+var
+  I: Integer;
+begin
+  Result := False;
+  for I := Low(CSIDLtoFOLDERID) to High(CSIDLtoFOLDERID) do
+  begin
+    if CSIDLtoFOLDERID[I].FOLDERID <> nil then
+    begin
+      if IsEqualGUID(CSIDLtoFOLDERID[I].FOLDERID^, FOLDERID) then
+      begin
+        CSIDL := CSIDLtoFOLDERID[I].CSIDL;
+        Result := True;
+        Break;
+      end;
+    end;
+  end;
+end;
+
 finalization
   FinitDLL;
 
windirs.pp.patch (24,331 bytes)

Michael Van Canneyt

2018-02-24 13:20

administrator   ~0106562

Tested and applied, thank you very much!

Issue History

Date Modified Username Field Change
2018-02-06 03:19 Denis Kozlov New Issue
2018-02-06 03:19 Denis Kozlov File Added: windirs.pp.patch
2018-02-06 03:19 Denis Kozlov Tag Attached: patch
2018-02-06 08:48 Michael Van Canneyt Assigned To => Michael Van Canneyt
2018-02-06 08:48 Michael Van Canneyt Status new => assigned
2018-02-24 13:20 Michael Van Canneyt Fixed in Revision => 38328
2018-02-24 13:20 Michael Van Canneyt Note Added: 0106562
2018-02-24 13:20 Michael Van Canneyt Status assigned => resolved
2018-02-24 13:20 Michael Van Canneyt Fixed in Version => 3.1.1
2018-02-24 13:20 Michael Van Canneyt Resolution open => fixed
2018-02-24 13:20 Michael Van Canneyt Target Version => 3.2.0