// Include file for Free Pascal Compiler // contains missing declaration from units JclShell & ShlObj const shell32 = 'shell32.dll'; CSIDL_DESKTOP = $0000; CSIDL_INTERNET = $0001; CSIDL_PROGRAMS = $0002; CSIDL_CONTROLS = $0003; CSIDL_PRINTERS = $0004; CSIDL_PERSONAL = $0005; CSIDL_FAVORITES = $0006; CSIDL_STARTUP = $0007; CSIDL_RECENT = $0008; CSIDL_SENDTO = $0009; CSIDL_BITBUCKET = $000a; CSIDL_STARTMENU = $000b; CSIDL_DESKTOPDIRECTORY = $0010; CSIDL_DRIVES = $0011; CSIDL_NETWORK = $0012; CSIDL_NETHOOD = $0013; CSIDL_FONTS = $0014; CSIDL_TEMPLATES = $0015; CSIDL_COMMON_STARTMENU = $0016; CSIDL_COMMON_PROGRAMS = $0017; CSIDL_COMMON_STARTUP = $0018; CSIDL_COMMON_DESKTOPDIRECTORY = $0019; CSIDL_APPDATA = $001a; CSIDL_PRINTHOOD = $001b; CSIDL_ALTSTARTUP = $001d; // DBCS CSIDL_COMMON_ALTSTARTUP = $001e; // DBCS CSIDL_COMMON_FAVORITES = $001f; CSIDL_INTERNET_CACHE = $0020; CSIDL_COOKIES = $0021; CSIDL_HISTORY = $0022; function SHGetMalloc(var ppMalloc: IMalloc): HResult; stdcall; external shell32 name 'SHGetMalloc'; function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer; var ppidl: PItemIDList): HResult; stdcall; external shell32 name 'SHGetSpecialFolderLocation'; function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall; external shell32 name 'SHGetPathFromIDListA'; //-------------------------------------------------------------------------------------------------- function PidlFree(var IdList: PItemIdList): Boolean; var Malloc: IMalloc; begin Result := False; if IdList = nil then Result := True else begin if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then begin Malloc.Free(IdList); IdList := nil; Result := True; end; end; end; //-------------------------------------------------------------------------------------------------- function PidlToPath(IdList: PItemIdList): string; begin SetLength(Result, MAX_PATH); if SHGetPathFromIdList(IdList, PChar(Result)) then StrResetLength(Result) else Result := ''; end; //-------------------------------------------------------------------------------------------------- function GetSpecialFolderLocation(const Folder: Integer): string; var FolderPidl: PItemIdList; begin if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then begin Result := PidlToPath(FolderPidl); PidlFree(FolderPidl); end else Result := ''; end; //--------------------------------------------------------------------------------------------------