Как на Delphi создать ярлык для сторонней программы?

[alexusankov]

Здравствуйте!
Хотел поинтересоваться.
Сижу бьюсь, весь вечер, перелопатил весь интернет, что нашел - у меня не пашет.
Собственно, имеется файл, на диске D, для него нужно создать ярлык, на рабочем столе.
Кто сможет показать как это?

[_SERGEYX_]

Да, запросто...

uses ComObj, ActiveX, ShlObj, Registry;

const
  SFolderKey = '\Software\Microsoft\Windows\CurrentVersion\' +
    'Explorer\Shell Folders';


//ищем путь папки в реестре
function GetFolderLocation(const FolderType: string): string;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if not OpenKey(SFolderKey, False) then
      raise ERegistryException.CreateFmt('Ключ "%s" не найден',
        [SFolderKey]);
    Result := ReadString(FolderType);
    if Result = '' then
      raise ERegistryException.CreateFmt('"%s" не найден в реестре',
        [FolderType]);
    CloseKey;
  finally
    Free;
  end;
end;

//Кликаем по кнопке
procedure TfrmMain.RzBitBtn3Click(Sender: TObject);
const AppName = 'D:\MyFolder\MyFile.exe';
var
  SL: IShellLink;
  PF: IPersistFile;
  LnkName: WideString;
begin
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
    IShellLink, SL));
  PF := SL as IPersistFile;
  OleCheck(SL.SetPath(PChar(AppName)));
  LnkName := GetFolderLocation('Desktop') + '\' +
    ChangeFileExt(ExtractFileName(AppName), '.lnk');
  PF.Save(PWideChar(LnkName), True);
end;

[MyLastHit]

На изучение...

[alexusankov]

[Error] Unit1.pas(178): Undeclared identifier: 'GetFolderLocation'? вот что выдает((

Создает ярлык, все ОК.
НО!!!!!!!!!!!
Третий раз все смотрел, ничего не понял. В общем ситуация такая, абсолютно непонятная и идиотская.
Мой инсталлятор, копирует 3 файла. 1 ехе и 2 с настройками. Так вот.
После того как он создает ярлык этой вот функцией, что я взял отсюда, получается следующее.
ЕСЛИ, я запускаю программу, через создавшийся ярлык - сама программа НЕ видит своих 2 тхт файлов с настройками. Если тупо щелкаю по ехе - все работает. В чем может быть причина?

Создаю ярлык руками - все работает. Сам инсталлятор когда создает ярлык - программа не видит своих файлов настроек

[alexusankov]

Ммм, кто нибудь попробует глянуть почему такая ситуация с ярлыком?
Сейчас приведу немного урезанный код, ток не смейтесь - поя первая программка инсталлятор.
[code]
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls, StdCtrls, ComCtrls, Buttons, ShlObj, FileCtrl,ActiveX,
ComObj, Registry ;
const
SFolderKey = '\Software\Microsoft\Windows\Curren tVersion\' +
'Explorer\Shell Folders';
var
Form1: TForm1;
inst : string;

implementation

{$R *.dfm}

function Getloka(const FolderType: string): string;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if not OpenKey(SFolderKey, False) then
raise ERegistryException.CreateFmt('Êëþ÷ "%s" íå íàéäåí',
[SFolderKey]);
Result := ReadString(FolderType);
if Result = '' then
raise ERegistryException.CreateFmt('"%s" íå íàéäåí â ðååñòðå',
[FolderType]);
CloseKey;
finally
Free;
end;
end;

procedure TForm1.Label1Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
pagecontrol1.Visible := false;
end;

procedure TForm1.Label2Click(Sender: TObject);
begin
pagecontrol1.Visible:=true;
pagecontrol1.ActivePageIndex :=0;
end;

procedure TForm1.Label4Click(Sender: TObject);
begin
pagecontrol1.Visible := false
end;

procedure TForm1.Label5Click(Sender: TObject);
begin
if checkbox1.Checked then pagecontrol1.ActivePageIndex :=1;

end;

procedure TForm1.Label7Click(Sender: TObject);
begin
pagecontrol1.ActivePageIndex :=0;
end;
function ShowChooseDirDialog: String;
const
TitleName = 'Óêàæèòå ïàïêó íàçíà÷åíèÿ'; // ýòî ïîäñêàçêà
var
lpItemID: PItemIDList;
BrowseInfo: TBrowseInfo;
DisplayName: array[0..MAX_PATH] of Char;
TempPath: array[0..MAX_PATH] of Char;
begin
Result := '';
FillChar(BrowseInfo, sizeof(TBrowseInfo), 0);
//Çäåñü íóæíî èñïîëüçîâàòü èìåííî Application.Handle
BrowseInfo.hwndOwner := Application.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
BrowseInfo.lpszTitle := @TitleName[1];
// NEWDIALOGSTYLE - áóäåò äîáàâëåíà êíîïêà "Ñîçäàòü ïàïêó"
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemID <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
Result := String(TempPath);
GlobalFreePtr(lpItemID);
end;
end;



procedure TForm1.Button1Click(Sender: TObject);
var path : string;
var inst : string;
begin
edit1.Text := ShowChooseDirDialog();
path := edit1.Text+'\wow.exe';
inst := edit1.Text;
if fileexists(path) then
begin
label8.Visible := true;

end
else application.MessageBox('Ê ñîæàëåíèþ â äàííîé ïàïêå, íå íàéäåí ôàéë wow.exe','Çëî!');
end;

procedure TForm1.TabSheet2Show(Sender: TObject);
begin
progressbar1.Visible :=false;
label8.Visible :=false;
end;

procedure installsoft(inst:string);
var
SL: IShellLink;
PF: IPersistFile;
LnkName: WideString;
AppName : string;
var exeshka : string;
var sets : string;
var realms : string;
i: integer;
links : string;
begin
inst :=form1.Edit1.Text;
exeshka := inst+'\realms.exe';
sets := inst+'\set.ini';
realms := inst+'\realms.txt';
CopyFile(pchar('shell.dll'),pchar(e xeshka),true);
CopyFile(pchar('set.dll'),pchar(set s),true);
CopyFile(pchar('realms.dll'),pchar( realms),true);
form1.Edit1.Visible :=false;
form1.ProgressBar1.Visible :=true;
form1.ProgressBar1.Min :=1;
form1.ProgressBar1.Max :=20;
for i:=1 to 20 do
begin
form1.ProgressBar1.Position :=i;
sleep(50);
end;
appname := exeshka;
//ftgdftdft
OleCheck(CoCreateInstance(CLSID_She llLink, nil, CLSCTX_INPROC_SERVER,IShellLink, SL));
PF := SL as IPersistFile;
OleCheck(SL.SetPath(PChar(AppName)) );
LnkName := Getloka('Desktop') + '\' + ChangeFileExt(ExtractFileName(AppNa me), '.lnk');
PF.Save(PWideChar(LnkName), True);

//ertertert




form1.PageControl1.ActivePageIndex: =2;

end;

procedure TForm1.Label8Click(Sender: TObject);
begin
installsoft(inst);
end;

procedure TForm1.Label9Click(Sender: TObject);
begin
application.Terminate();
end;

end.

[alexusankov]

Слегка урезал, т.к. не влезает в поле более 5000 символов, срезал блок Type

[alexusankov]

Собственно, косяк начинается в procedure installsoft(inst:string);,
с коммента //ftgdftdft

[asmodey1]

OFFTOP, но все же...
alexusankov, вы кнопкой "Правка" пользоваться не умеете ?
Или ждете, когда кто-нибудь из модеров "даст вам по башке" ?