Delphi 创建具有负IconIndex值的ShellLink时出错

在DelphiXe7中，我使用此代码创建指向特定文件夹的SHELL链接。此文件夹显示在Windows资源管理器中，其中有一个自定义文件夹图标，该图标由该文件夹中的desktop.ini文件定义。SHELL链接应使用desktop.ini文件中的图标参数创建，即指向与desktop.ini文件相同的图标资源。下面是代码：

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);

在这种情况下，创建的SHELL链接是错误的，这意味着SHELL链接不包含正确的图标引用

---

那么，如何将desktop.ini文件中的负IconIndex值

-101

转换为可在

MyCreateShellLink

函数中使用的值呢？

如果要使用负IconIndex，请将图标的完整路径传递给SetIconLocation。使用以下版本的GetDesktoPinicondAframFolder：

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;

它会自动展开图标路径的变量。它还支持desktop.ini的IconResource参数

变体2（通用）

函数getObjectConfilename（AParentWnd:HWND；const AName:UnicodeString；var AIndex:Integer）：UnicodeString；
变量
桌面：IShell文件夹；
Attr:DWORD；
德沃德；
懒惰者：可怜的人；
父文件夹：IShellFolder；
孩子：可怜虫；
ExtractIconW:IEExtractConw；
ExtractIconA:IEExtractCona；
AnsiResult:AnsiString；
旗帜:德沃德,；
分机：单兵摧毁；
尺寸：德沃德；
P：整数；
开始
OleCheck（SHGetDesktopFolder（桌面））；
尝试
属性：=SFGAO_流；
olcheck（Desktop.ParseDisplayName（AParentWnd，nil，PWideChar（AName），eat，IDList，Attr））；
尝试
olcheck（SHBindToParent（IDList、IShellFolder、指针（父）、子））；
如果成功（Parent.GetUIObjectOf（AParentWnd，1，Child，iextractconw，nil，ExtractIconW）），则
尝试
设置长度（结果，最大路径+1）；
如果（ExtractIconW.GetIconLocation（0，PWideChar（结果），MAX_PATH，AIndex，Flags）=S_OK），那么
开始
结果：=PWideChar（结果）；
如果//（Flags和GIL\u NOTFILENAME=0）和//不知道shell为什么返回GIL\u NOTFILENAME flag
文件存在（结果）然后
出口
其他的
结果：=''；
终止
其他的
结果：=''；
最后
ExtractIconW:=零；
终止
其他的
如果成功（Parent.GetUIObjectOf（AParentWnd，1，Child，iextractcona，nil，ExtractIconA）），则
尝试
设置长度（AnsiResult，最大路径+1）；
如果（ExtractIconA.GetIconLocation（0，PAnsiChar（AnsiResult），MAX_PATH，AIndex，Flags）=S_OK），那么
开始
结果：=单破坏（PAnsiChar（AnsiResult））；
如果//（Flags和GIL\u NOTFILENAME=0）和//不知道shell为什么返回GIL\u NOTFILENAME flag
文件存在（结果）然后
出口
其他的
结果：=''；
终止
其他的
结果：=''；
最后
ExtractIconA:=零；
终止
最后
CoTaskMemFree（空闲）；
终止
最后
桌面：=零；
终止
如果Attr和SFU流为0，则
开始
Ext:=ExtractFileExt（AName）；
如果（AssocQueryStringW（ASSOCF_NONE，ASSOCSTR_DEFAULTICON，PWideChar（Ext），nil，nil，@BuffSize）=S_FALSE）和（BuffSize>1），则
开始
设置长度（结果，BuffSize-1）；
如果成功（AssocQueryStringW（ASSOCF_NONE，ASSOCSTR_DEFAULTICON，PWideChar（Ext），nil，PWideChar（Result），@BuffSize）），则
开始
AIndex:=0；
P:=LastDelimiter（'，'，Result）；
如果P>0，则
开始
AIndex:=strotintdef（复制（结果，P+1，MaxInt），MaxInt）；
如果是AIndex MaxInt，那么
删除（结果，P，MaxInt）
其他的
AIndex:=0；
终止
出口
终止
终止
终止
结果：=''；
终止

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;

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;