function TMain.GetShellIcon(FileName:
string): integer;
var
isfWork : IShellFolder;
piidWork : PItemIdList;
dwDummy : DWORD;
fiWork : TSHFileInfo;
wsWork : WideString;
begin
Result:=0;
// Interface auf IShellLink holen
SHGetDesktopFolder(isfWork);
//Falls ein Laufwerksbuchstabe übergeben wurde...
if Length(FileName) = 1
then
FileName := FileName + '
:';
//Laufwerke sollten mit \ enden...
if (Length(FileName) = 2)
and (copy(FileName, length(FileName), 1) = '
:')
and
(copy(FileName, length(FileName), 1) <> '
\')
then
FileName := FileName + '
\';
// Dateiname; Vielleicht geht auch nur die Extension
wsWork := FileName;
// Weil Borland ja bei Pointern immer var Parameter nimmt ist ein Dummy erforderlich
dwDummy := 0;
// ItemIdList des Pfades holen
isfWork.ParseDisplayName(0,
nil,PWideChar(wsWork),dwDummy,piidWork,dwDummy);
// Und die Info abfragen
SHGetFileInfo(PChar(piidWork),0,fiWork,SizeOf(fiWork),SHGFI_PIDL
or SHGFI_ICON
or SHGFI_SMALLICON);
// fiWork.iIcon enthält jetzt auch den Index in der SystemImageList, hIcon das Handle
try
//IconIndex liefern...
Result := fiWork.iIcon
finally
// you are responsible for destroying the icon handle
DestroyIcon(fiWork.hIcon);
end;
end;