Error in ShellLink creation with negative IconIndex value

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?

Denis Anisimov · Accepted Answer · 2015-03-12T19:46:15.283

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;

Error in ShellLink creation with negative IconIndex value

1 Answers1