Error in ShellLink creation with negative IconIndex value - delphi

Question

In Delphi XE7, I use this code to create a SHELL LINK pointing to a specific folder. This folder is displayed in Windows Explorer with a custom folder icon defined by a desktop.ini file inside this folder. The SHELL LINK should be created with the icon parameters found in the desktop.ini file, i.e. pointing to the same icon resource as the desktop.ini file. So here is the code:
function GetDesktopIniIconDataFromFolder(const APath: string; var VIconIndex: Integer): string;
var
DeskTopIniFile: string;
DesktopIni: System.IniFiles.TIniFile;
ThisIconFileStr, ThisIconIndexStr: string;
ThisIconIndexInt: Integer;
begin
Result := '';
if DirectoryExists(APath) then
begin
DeskTopIniFile := IncludeTrailingPathDelimiter(APath) + 'Desktop.ini';
if FileExists(DeskTopIniFile) then
begin
DesktopIni := System.IniFiles.TIniFile.Create(DeskTopIniFile);
try
ThisIconFileStr := DesktopIni.ReadString('.ShellClassInfo', 'IconFile', '');
if ThisIconFileStr <> '' then
begin
ThisIconIndexStr := DesktopIni.ReadString('.ShellClassInfo', 'IconIndex', '');
if ThisIconIndexStr <> '' then
begin
ThisIconIndexInt := System.SysUtils.StrToIntDef(ThisIconIndexStr, MaxInt);
if ThisIconIndexInt <> MaxInt then
begin
Result := ThisIconFileStr;
VIconIndex := ThisIconIndexInt;
end;
end;
end;
finally
DesktopIni.Free;
end;
end;
end;
end;
function MyCreateShellLink(const LinkFileName, AssocFileName, Desc, WorkDir,
Args, IconFileName: string; const IconIdx: Integer): Boolean;
var
SL: Winapi.ShlObj.IShellLink;
PF: Winapi.ActiveX.IPersistFile;
begin
Result := False;
Winapi.ActiveX.CoInitialize(nil);
try
if Winapi.ActiveX.Succeeded(
Winapi.ActiveX.CoCreateInstance(
Winapi.ShlObj.CLSID_ShellLink,
nil,
Winapi.ActiveX.CLSCTX_INPROC_SERVER,
Winapi.ShlObj.IShellLink, SL
)
) then
begin
SL.SetPath(PChar(AssocFileName));
SL.SetDescription(PChar(Desc));
SL.SetWorkingDirectory(PChar(WorkDir));
SL.SetArguments(PChar(Args));
if (IconFileName <> '') and (IconIdx >= 0) then
SL.SetIconLocation(PChar(IconFileName), IconIdx);
PF := SL as Winapi.ActiveX.IPersistFile;
Result := Winapi.ActiveX.Succeeded(
PF.Save(PWideChar(WideString(LinkFileName)), True)
);
end;
finally
Winapi.ActiveX.CoUninitialize;
end;
end;
// Usage:
var
IconFile: string;
IconIndex: Integer;
begin
IconFile := GetDesktopIniIconDataFromFolder(APath, IconIndex);
if IconFile <> '' then
MyCreateShellLink(ALinkFileName, ATargetFileName, ADescription, AWorkDir, AArgs, IconFile, IconIndex);
This works well, EXCEPT in cases where the IconIndex in the desktop.ini file is a negative value (which means the negative value indicates a resource ID rather than an ordinal value), like in this example:
[.ShellClassInfo]
InfoTip=#Shell32.dll,-12688
IconFile=%SystemRoot%\system32\mydocs.dll
IconIndex=-101
In this case the created SHELL LINK is erroneous, which means the Shell LINK does not contain the correct icon reference.
So how can I translate the negative IconIndex value -101 from the desktop.ini file to a value I can use in the MyCreateShellLink function?

Answer 1

If you want to use negative IconIndex then pass FULL path of icon to SetIconLocation. Use the following variant of GetDesktopIniIconDataFromFolder:
function GetDesktopIniIconDataFromFolder(const APath: string; var AIconIndex: Integer): string;
var
Setting: TSHFolderCustomSettings;
begin
ZeroMemory(#Setting, SizeOf(Setting));
Setting.dwSize := SizeOf(Setting);
Setting.dwMask := FCSM_ICONFILE;
SetLength(Result, MAX_PATH + 1);
Setting.pszIconFile := PChar(Result);
Setting.cchIconFile := MAX_PATH;
if Succeeded(SHGetSetFolderCustomSettings(#Setting, PChar(APath), FCS_READ)) then
begin
Result := PChar(Result);
AIconIndex := Setting.iIconIndex;
end
else
Result := '';
end;
It automatically expands variables of icon path. Also it supports IconResource parameter of desktop.ini.
Variant 2 (universal)
function GetObjectIconFileName(AParentWnd: HWND; const AName: UnicodeString; var AIndex: Integer): UnicodeString;
var
Desktop: IShellFolder;
Attr: DWORD;
Eaten: DWORD;
IDList: PItemIDList;
Parent: IShellFolder;
Child: PItemIDList;
ExtractIconW: IExtractIconW;
ExtractIconA: IExtractIconA;
AnsiResult: AnsiString;
Flags: DWORD;
Ext: UnicodeString;
BuffSize: DWORD;
P: Integer;
begin
OleCheck(SHGetDesktopFolder(Desktop));
try
Attr := SFGAO_STREAM;
OleCheck(Desktop.ParseDisplayName(AParentWnd, nil, PWideChar(AName), Eaten, IDList, Attr));
try
OleCheck(SHBindToParent(IDList, IShellFolder, Pointer(Parent), Child));
if Succeeded(Parent.GetUIObjectOf(AParentWnd, 1, Child, IExtractIconW, nil, ExtractIconW)) then
try
SetLength(Result, MAX_PATH + 1);
if (ExtractIconW.GetIconLocation(0, PWideChar(Result), MAX_PATH, AIndex, Flags) = S_OK) then
begin
Result := PWideChar(Result);
if // (Flags and GIL_NOTFILENAME = 0) and // Dont know why shell return GIL_NOTFILENAME flag
FileExists(Result) then
Exit
else
Result := '';
end
else
Result := '';
finally
ExtractIconW := nil;
end
else
if Succeeded(Parent.GetUIObjectOf(AParentWnd, 1, Child, IExtractIconA, nil, ExtractIconA)) then
try
SetLength(AnsiResult, MAX_PATH + 1);
if (ExtractIconA.GetIconLocation(0, PAnsiChar(AnsiResult), MAX_PATH, AIndex, Flags) = S_OK) then
begin
Result := UnicodeString(PAnsiChar(AnsiResult));
if // (Flags and GIL_NOTFILENAME = 0) and // Dont know why shell return GIL_NOTFILENAME flag
FileExists(Result) then
Exit
else
Result := '';
end
else
Result := '';
finally
ExtractIconA := nil;
end;
finally
CoTaskMemFree(IDList);
end;
finally
Desktop := nil;
end;
if Attr and SFGAO_STREAM <> 0 then
begin
Ext := ExtractFileExt(AName);
if (AssocQueryStringW(ASSOCF_NONE, ASSOCSTR_DEFAULTICON, PWideChar(Ext), nil, nil, #BuffSize) = S_FALSE) and (BuffSize > 1) then
begin
SetLength(Result, BuffSize - 1);
if Succeeded(AssocQueryStringW(ASSOCF_NONE, ASSOCSTR_DEFAULTICON, PWideChar(Ext), nil, PWideChar(Result), #BuffSize)) then
begin
AIndex := 0;
P := LastDelimiter(',', Result);
if P > 0 then
begin
AIndex := StrToIntDef(Copy(Result, P + 1, MaxInt), MaxInt);
if AIndex <> MaxInt then
Delete(Result, P, MaxInt)
else
AIndex := 0;
end;
Exit;
end;
end;
end;
Result := '';
end;