如何修改Windows快捷方式路径且不更改其原有图标

你当前代码的核心问题有两个：

• 直接创建了全新的IShellLink实例覆盖原有快捷方式，没有读取原有快捷方式的图标配置
• 代码中SetIconLocation(PWideChar(''), 0)主动设置了使用目标程序的默认图标，导致图标被强制替换

修改逻辑为：先加载已存在的快捷方式，读取原有图标配置，修改目标路径后再还原图标配置即可，不要重置图标位置。修改后完整代码如下：

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;
  // 新增变量存储原有图标信息
  szIconPath: array[0..MAX_PATH] of Char;
  iIconIndex: Integer;
begin
  CoInitialize(nil); // 初始化COM环境，避免部分系统下调用失败
  try
    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;

    // 先加载原有快捷方式，而不是直接新建覆盖
    MyPFile.Load(PWideChar(WideString(LnkPath)), STGM_READWRITE);

    // 读取原有图标配置保存
    MySLink.GetIconLocation(szIconPath, MAX_PATH, iIconIndex);

    with MySLink do
    begin
      SetDescription('');
      SetPath(PWideChar(sExePath));
      SetArguments(PWideChar(sParams));
      SetWorkingDirectory(PWideChar(ExtractFilePath(sExePath)));
      // 还原原有图标配置，不要设置为空
      SetIconLocation(szIconPath, iIconIndex);
    end;

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

如果是创建全新的快捷方式需要指定固定图标，直接给SetIconLocation传入你要使用的图标文件路径（支持exe、dll、ico格式）和对应的图标索引即可，不要传空字符串。

内容的提问来源于stack exchange，提问作者FLASHCODER