[Gareth]

Здравствуйте.

Делаю программку, с помощью которой можно будет настраивать свойство ярлыка.

В программе я указываю путь к exe файлу, который мне придется дублировать(кинуть на раб. стол) и изменить его свойства. Всё это я уже сделал.
Мне осталось лишь научить программу менять иконку ярлыка.

Вытащить иконку с любого ярлыка я могу, но вот вставить в свой(дублированный ярлык) не могу. Прошу помощи.

Хочу привести код, с которым я редактирую свойства ярлыка.

Код:

procedure TForm1.createshotcut(sourcefile, shortcutname,
  sourceparams: string);
var
 IUnk: IUnknown;
 ShellLink: IShellLink;
 ShellFile: IPersistFile;
 tmpShortCutName: string;
 WideStr: WideString;
 i: Integer;
begin
 IUnk := CreateComObject(CLSID_ShellLink);
 ShellLink := IUnk as IShellLink;
 ShellFile  := IUnk as IPersistFile;

 ShellLink.SetPath(PChar(SourceFile));
 ShellLink.SetArguments(PChar(SourceParams));
 ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));

 ShortCutName := ChangeFileExt(ShortCutName,'.lnk');
 if fileexists(ShortCutName) then
  begin
   ShortCutName := copy(ShortCutName,1,length(ShortCutName)-4);
   i := 1;
   repeat
    tmpShortCutName := ShortCutName +'(' + inttostr(i)+ ').lnk';
    inc(i);
   until not fileexists(tmpShortCutName);
   WideStr := tmpShortCutName;
 end
  else
   WideStr := ShortCutName;
 ShellFile.Save(PWChar(WideStr),False);
end;


procedure TForm1.sButton2Click(Sender: TObject);
var
 WorkTable:String;
 P:PItemIDList;
 C:array [0..1000] of char;
begin

 if SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,p)=NOERROR then
  begin
   SHGetPathFromIDList(P,C);
   WorkTable:=StrPas(C);
  end;

 if FileExists(WorkTable+'\'+ExtractFileName(Application.ExeName)) then
  DeleteFile(WorkTable+'\'+ExtractFileName(Application.ExeName));

 CreateShotCut(sEdit1.Text, WorkTable+'\'+ExtractFileName(sEdit2.Text), sEdit3.Text);
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
if sopendialog1.Execute then
 S:=sOpenDialog1.FileName;
 sedit1.Text:=S;
 sButton2.Enabled:=True;
end;

Каким образом я могу изменить иконку создаваемого ярлыка ? По стандарту иконка остается от оригинала.
Спасибо.

[Alegun]

Сообщение от Gareth

...Каким образом я могу изменить иконку...

Код:

uses
 ShlObj, ComObj, ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
   IObject: IUnknown;
   SLink: IShellLink;
   ShellFile: IPersistFile;
begin
   IObject:= CreateComObject(CLSID_ShellLink);
   SLink:= IObject as IShellLink;
   ShellFile:= IObject as IPersistFile;
   ShellFile.Load('Some.lnk', 0);
   SLink.SetIconLocation('C:\Documents and Settings\icn\icon9.ico', 0);
   ShellFile.Save(PWChar(WideString('Some.lnk')), false);
end;

Проверено под ХР на D7

[Gareth]

Не могли бы вы прокомментировать последние 3 строки ?
Пожалуйста.

[Gareth]

Сообщение от Gareth

Не могли бы вы прокомментировать последние 3 строки ?
Пожалуйста.

Код:

   ShellFile.Load('Some.lnk', 0); //  это мой ярлык который я создал? 
   SLink.SetIconLocation('C:\Documents and Settings\icn\icon9.ico', 0); // это иконка на которую меняется ярлык ?
   ShellFile.Save(PWChar(WideString('Some.lnk')), false);
end;

[Alegun]

Да посмотрите свойства IShellLink, ими можно даже стрелку изменять показывающую что это - ярлык