I have the following code that changes path of one shortcut. Happens that when path is changed, the icon also is updated to icon of new application.

How change path wihout update icon of shortcut?

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;

CodePudding user response：

You can't prevent the icon from being updated.

What you can do is retrieve the current icon via IShellLink.GetIconLocation() before setting the new path, and then you can restore the icon afterwards, eg:

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;