delphidelphi-10.4-sydneyshortcut-file

How change shortcut path without update your icon?


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;

Solution

  • 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;