Помогите создать ярлык.

[Kashp]

uses ... shlObj, ActiveX, comObj
...
procedure TForml.Button2Click(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;

CreateShotCut(Application.ExeName, WorkTable + ' \ ' +
ExtractFileName(Application.ExeName), ' ');
end;

Вот собственно нужно создать ярлычок на рабочем столе. Вот подскажите, этот код вообще работающий? И объясните пожалуйста про последние две строки:
CreateShotCut... и ExtractFileName... , куда вот там надо вписывать путь к самому файлу, а куда имя ярлыка? И если не трудно, напишите пример (допустим файл лежит тут: D:\\X.exe )

Заранее благодарен!

[Xandr]

Вот попробуй этот:

uses ShlObj, ComObj, ActiveX;

procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject := CreateComObject(CLSID_ShellLink);
SLink := IObject as IShellLink;
PFile := IObject as IPersistFile;
with SLink do begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj));
end;
PFile.Save(PWChar(WideString(PathLi nk)), FALSE);
end;

[Kashp]

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

Вот попробуй этот:

А ратолкуй пожалуйста эти строки:

SetArguments(PChar(Param)); 
SetDescription(PChar(Desc)); 
SetPath(PChar(PathObj)); 
end; 
PFile.Save(PWChar(WideString(PathLink)), FALSE);

Куда тут подставлять путь до моего exe'шника?

[Xandr]

Спросил...
Я этим не пользовался взял конкретный пример из мануала.
Вот еще тут расписано все:

ВХОДНЫЕ ПАРАМЕТРЫ.
FILENAME - имя файл ДЛЯ КОТОРОГО будет создан ярлык (*.lnk).
DestDirectory - путь к каталогу, в котором должен быть расположен
создаваемый ярлык.
OverwriteExisting - если TRUE, то в случае существования создаваемого ярлыка
в папке назначения, то существующий ярлык с
подобным именем будет переписан.
AddNumberIfExists - если TRUE, то в при существовании ярлыка с подобным
именем в папке назначения,существующий ярлык не будет переписан, а к
создаваемому ярлыку будет добавлено число, определяющее номер копии
создаваемого ярлыка.

ВНИМАНИЕ !!! Параметр OverwriteExisting является более влиятельным по
отношению к параметру AddNumberIfExists, т.е. при передачи
обоим параметрам TRUE, существующий ярлык
(если таковой имеется в папке назначения),
будет переписан.

Зависимости: shlObj, activeX, SysUtils, filectrl, comObj, UBPFD.ExtractFileNameEX
Автор: VID, snap@iwt.ru, ICQ:132234868, Махачкала
Copyright: Списал с одного из FAQ + собственные корректировки и расширение возможностей
Дата: 19 апреля 2002 г.
*********************************** ****************** }

function CreateLink(FileName, DestDirectory: string; OverwriteExisting,
AddNumberIfExists: Boolean): string;

var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WFileName: WideString;
X: INTEGER;
begin
//Изначально RESULT = ''
Result := '';
//Если фиайла, для которого создаётся ярлык не существует, или же не
// существует директории, где должен быть создан ярлык файла, то EXIT
if (FileExists(FileName) = FALSE) or (DirectoryExists(DestDirectory) = FALSE)
then
exit;
MyObject := CreateComObject(CLSID_SHELLLINK);
MyPFile := MyObject as IPersistFile;
MySLink := MyObject as IShellLink;
with MySLink do
begin
SetArguments('');
SetPath(PChar(FileName));
SetWorkingDirectory(PChar(ExtractFi lePath(FileName)));
end;

//Гарантирование проставление завершающего '\' в пути директории
//расположения создаваемого ярлыка
if DestDirectory[length(DestDirectory)] <> '\' then
DestDirectory := DestDirectory + '\';
// Первичное определене будующего имени ярлыка
WFileName := DestDirectory + ExtractFileNameEx(FileName, FALSE) + '.lnk';
//Если ярлык с таким именем уже существует, то
if (FileExists(WFileName)) then
begin
// Если не надо переписывать существующий ярлык, а надо добавить
// порядковый номер существования к имени создаваемого ярлыка, например
// blobby1.lnk, blobby2.lnk
if (OverwriteExisting = FALSE) and (AddNumberIfExists = TRUE) then
begin
// Определяем какой именно порядковый номер надо добавить к
// имени ярлыка
X := 0;
repeat
X := X + 1;
WFileName := DestDirectory + ExtractFileNameEx(FileName, FALSE)
+ IntToStr(X) + '.lnk';
until FileExists(WFileName) = FALSE;
// И сохраняем ярлык
MyPFile.Save(PWChar(WFileName), FALSE);
Result := WFileName;
end;
//Если надо переписывать существующий ярлык
if OverwriteExisting = TRUE then
begin
//..., то переписываем его
MyPFile.Save(PWChar(WFileName), FALSE);
Result := WFileName;
end;
end
else
begin
//В случае, если ярлыка с подобным имененм ещё нет в папке
//назначения, то создаём ярлык
MyPFile.Save(PWChar(WFileName), FALSE);
Result := WFileName;
end;
end;

[mutabor]

CreateShotCut это наверное пользовательская функция, тем более слово с ошибкой. Поищи там где ты взял исходник может ее код есть.

[Kashp]

Вот еще нашел пример:

uses ShlObj, ActiveX, ComObj, registry ...
.....

{ Private declarations }
    procedure CreateShortcut(const FilePath, ShortcutPath, WorkDir, Description, Params: string);
.....

procedure TForm1.CreateShortcut(const FilePath, ShortcutPath, WorkDir,
  Description, Params: string);

var
UserDesktop: string;
R: TRegIniFile;
begin
R := TRegIniFile.Create('');
  with R do
  begin
    RootKey := HKEY_CURRENT_USER;
    UserDesktop :=
      ReadString('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', 'Common Desktop', ' ');
    Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateShortCut ('D:\a.exe', 'Common Desktop' + '\Имя ярлыка.lnk', 'D:\', ' ',' ');

end;

Компилируется, запускаю - ярлык не создается
Ну что же такое?

[Kashp]

Все, разобрался

[mutabor]

Если не трудно, дай рабочий код.

[Kashp]

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

Если не трудно, дай рабочий код.

Вот пример, который создает ярлык при нажатии кнопки:

uses ShlObj, ComObj, ActiveX;
...
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject := CreateComObject(CLSID_ShellLink);
SLink := IObject as IShellLink;
PFile := IObject as IPersistFile;
with SLink do begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj));
end;
PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateLink('путь к exe файлу', 'c:\documents and settings\папка юзера\рабочий стол\имя ярлыка.lnk', 'всплывающая подсказка', ' ');
end;