How change shortcut path without update your icon? - delphi

Question

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;

Answer 1

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;