如何在不更新图标的情况下更改快捷方式路径？

Question

我有以下代码可以更改一个快捷方式的路径。发生路径更改时，图标也会更新为新应用程序的图标。

如何在不更新快捷方式图标的情况下更改路径？

uses
 ActiveX,
 ComObj, 
 ShlObj;
 
 ...

function GetDesktopFolder: string;
var
  buf: array[0..MAX_PATH] of Char;
  pidList: PItemIDList;
begin
  Result := '';
  SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, pidList);
  if (pidList <> nil) then
    if (SHGetPathFromIDList(pidList, buf)) then
      Result := buf;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyObject: IUnknown;
  MySLink: IShellLink;
  MyPFile: IPersistFile;
  LnkPath, sExePath, sParams: string;
begin
  sParams := '';
  sExePath := 'C:\Program Files\Google\Chrome\Application\chrome.exe';
  LnkPath := GetDesktopFolder + '\Target.lnk';
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;

  with MySLink do
  begin
    SetDescription('');
    SetPath(PWideChar(sExePath));
    SetArguments(PWideChar(sParams));
    SetWorkingDirectory(PWideChar(ExtractFilePath(sExePath)));
    SetIconLocation(PWideChar(''), 0);
  end;

  MyPFile.Save(PWChar(WideString(LnkPath)), False);
  SHChangeNotify(SHCNE_UPDATEITEM, SHCNF_PATH, PWideChar(LnkPath), nil);
end;

Answer 1

您无法阻止图标被更新。

您可以在设置新路径之前通过IShellLink.GetIconLocation()检索当前图标，然后您可以在之后恢复图标，例如：

function GetDesktopFolder(Wnd: HWND = 0): string;
var
  buf: array[0..MAX_PATH] of Char;
begin
  if Wnd = 0 then Wnd := Application.Handle;
  if Succeeded(SHGetFolderPath(Wnd, CSIDL_DESKTOP, 0, SHGFP_TYPE_CURRENT, buf)) then
    Result := IncludeTrailingPathDelimiter(buf)
  else
    Result := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MySLink: IShellLink;
  MyPFile: IPersistFile;
  sLnkPath, sExePath, sParams: string;
  szIconPath: array[0..MAX_PATH] of Char;
  iIconIndex: Integer;
  bHasIcon: Boolean;
begin
  sParams := '';
  sExePath := 'C:\Program Files\Google\Chrome\Application\chrome.exe';
  sLnkPath := GetDesktopFolder(Handle) + 'Target.lnk';

  MySLink := CreateComObject(CLSID_ShellLink) as IShellLink;
  MyPFile := MySLink as IPersistFile;

  if Succeeded(MyPFile.Load(PChar(sLnkPath), STGM_READ)) then
  begin
    MySLink.Resolve(Handle, 0); 
    bHasIcon := Succeeded(MySLink.GetIconLocation(szIconPath, Length(szIconPath), @iIconIndex));
  end;

  with MySLink do
  begin
    SetDescription(PChar(''));
    SetPath(PChar(sExePath));
    SetArguments(PChar(sParams));
    SetWorkingDirectory(PChar(ExtractFilePath(sExePath)));
    if bHasIcon then
      SetIconLocation(szIconPath, iIconIndex)
    else
      SetIconLocation(PChar(''), 0);
  end;

  MyPFile.Save(PChar(sLnkPath), False);
  SHChangeNotify(SHCNE_UPDATEITEM, SHCNF_PATH, PChar(sLnkPath), nil);
end;