使用负IconIndex值创建ShellLink时出错

Question

在Delphi XE7中,我使用此代码创建指向特定文件夹的SHELL LINK.此文件夹显示在Windows资源管理器中,其中包含由此文件夹中的desktop.ini文件定义的自定义文件夹图标.应使用desktop.ini文件中的图标参数创建SHELL LINK,即指向与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);

这种方法效果很好,除非desktop.ini文件中的IconIndex为负值(这意味着负值表示资源ID而不是序数值),如下例所示:

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

在这种情况下,创建的SHELL LINK是错误的,这意味着Shell LINK不包含正确的图标引用.

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

Answer 1

如果要使用负IconIndex,则将图标的FULL路径传递给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;

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

变体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;