96 lines
3.2 KiB
Plaintext
96 lines
3.2 KiB
Plaintext
// 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;
|
|
|
|
//--------------------------------------------------------------------------------------------------
|
|
|