uses
CommCtrl, ShellAPI, ShlObj,
ActiveX;
{ ... }
procedure FreeItemIDList(
var pidl: pItemIDList);
var
ppMalloc : iMalloc;
begin
if(SHGetMalloc(ppMalloc) = S_OK)
then
try
ppMalloc.Free(pidl);
pidl :=
nil;
finally
ppMalloc :=
nil;
end;
end;
function SHGetIDListFromPath(
const Path:
string;
out pidl: PItemIDList):
boolean;
var
ppshf : IShellFolder;
wpath :
array[0..MAX_PATH]
of widechar;
pchEaten,
dwAttributes : Cardinal;
begin
// Standardergebnis
Result := false;
// IShellFolder-Handle holen
if(SHGetDesktopFolder(ppshf) = S_OK)
then
try
if(StringToWideChar(Path,wpath,sizeof(wpath)) <>
nil)
then
begin
// Pfadname in "PItemIdList" umwandeln
ppshf.ParseDisplayName(0,
nil,wpath,pchEaten,pidl,dwAttributes);
Result := pidl <>
nil;
end;
finally
ppshf :=
nil;
end;
end;
function SHGetIDListFromCSIDL(
const wnd: HWND;
const Csidl: integer;
out pidl: PItemIDList): boolean;
begin
Result := SHGetSpecialFolderLocation(wnd, Csidl, pidl) = S_OK;
end;
function GetShellImg(
const pidl: PItemIdList; fOpen: boolean): integer;
overload;
var
fi : TSHFileInfo;
dwFlags : dword;
begin
Result := -1;
if(pidl <>
nil)
then
begin
dwFlags := SHGFI_PIDL
or SHGFI_SYSICONINDEX;
if(fOpen)
then dwFlags := dwFlags
or SHGFI_OPENICON;
SHGetFileInfo(pchar(pidl),0,fi,sizeof(fi),dwFlags);
Result := fi.iIcon;
end;
end;
function GetShellImg(
const iDesktop: IShellFolder; pidl: PItemIdList;
fOpen: boolean): integer;
overload;
var
isi : IShellIcon;
uFlags : uint;
begin
if(iDesktop.QueryInterface(IID_IShellIcon,isi) = S_OK)
then
begin
if(fOpen)
then uFlags := GIL_OPENICON
else uFlags := 0;
if(isi <>
nil)
then
begin
if(isi.GetIconOf(pidl,uFlags,Result) <> NOERROR)
then
Result := GetShellImg(pidl,fOpen);
isi :=
nil;
end;
end
else
Result := GetShellImg(pidl,fOpen);
end;