创建具有负图标索引值的外壳链接时出错

Question

在Delphi XE7中，我使用此代码创建一个指向特定文件夹的SHELL LINK。此文件夹显示在 Windows 资源管理器中，并带有由此文件夹中的桌面.ini文件定义的自定义文件夹图标。SHELL 链接应使用桌面.ini文件中的图标参数创建，即指向与桌面.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);

这很有效，除非桌面.ini文件中的 IconIndex 是负值（这意味着负值表示资源 ID 而不是序号值），如以下示例所示：

[.ShellClassInfo]
InfoTip=@Shell32.dll,-12688
IconFile=%SystemRoot%system32mydocs.dll
IconIndex=-101

在这种情况下，创建的命令行管理程序链接是错误的，这意味着外壳链接不包含正确的图标引用。

那么如何将桌面文件中.ini负 IconIndex 值-101转换为我可以在MyCreateShellLink函数中使用的值呢？

Answer 1

如果要

使用负 IconIndex，则将 icon 的完整路径传递给 SetIconLocation。使用以下 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;

它会自动扩展图标路径的变量。此外，它还支持桌面.ini的图标资源参数。

变式2（通用）

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;