Ярлык к программе

[Amsterdam]

:) Хм, что-то у меня простая вроде вещь глючит:

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

Усе вроде компилится, но ярлык не создается.

Просто никакой реакции программы. :)

В то же время, если всего лишь заменить pChar(folder) на

pChar(ExtractFilePath(PathObj)) - типа, каталог программы, то

в этом каталоге ярлык создается прекрасно! <_<

Сижу за программой уже 'очень большой час', возможно, мозги устали и

не замечаю чего или торможу? :D

Короче, большая просьба помочь. Заранее всем благодарен. :lol:

{----====Код====----}

procedure TForm1.Button1Click(Sender: TObject);

var

IObject: IUnknown;

SLink: IShellLink;

List: pItemIDList;

PFile: IPersistFile;

folder: pChar;

PathObj, PathLink: string;

begin

PathObj:=ParamStr(0);

SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,List);

new(folder);

SHGetPathFromIDList(List,folder);

ChDir(folder);

PathLink := pChar(folder) + 'link.lnk'; //pChar(ExtractFilePath(PathObj)) вставить здесь заместо pCharFolder

IObject := CreateComObject(CLSID_ShellLink);

SLink := IObject as IShellLink;

PFile := IObject as IPersistFile;

with SLink do begin

SetDescription(pChar(Application.Title));

SetWorkingDirectory(pChar(ExtractFilePath(PathObj)));

SetPath(PChar(PathObj));

end;

PFile.Save(PWChar(WideString(PathLink)), TRUE);

end;

{----====Конец====----}

[aTeos]

Процедура создания ярлыка

procedure CreateLink(LNKPath,      // LNK file location                     CommandLine,  // command line to execute                     Args,         // command line arguments                     WorkDir,      // working directory                     IconLocation, // icon filename for shortcut                     ShortCutName  // shortcut name (LNK filename)                     : String);var  IObj: IUnknown;  Link: IShellLink;  IPFile: IPersistFile;  TargetW: WideString;begin  CoInitialize(nil);  IObj := CreateComObject(CLSID_ShellLink);  if IObj = nil then Exit;  Link := IObj as IShellLink;  IPFile := IObj as IPersistFile;  with Link do  begin    SetPath(PChar(CommandLine));    SetArguments(PChar(Args));    SetShowCmd(SW_SHOWNORMAL);    SetWorkingDirectory(PChar(WorkDir));    SetIconLocation(PChar(IconLocation),0);    SetDescription(PChar(ShortCutName));  end;  TargetW := LNKPath+'\'+ShortCutName+'.lnk';  IPFile.Save(PWChar(TargetW), False);  CoUnInitialize;end;

Как вызвать, думаю, разберешься. Если что, спрашивай

В Uses должно быть вроде подключено ShellAPI

Изменено 6 мая, 2004 пользователем aTeos

[Amsterdam]

В Uses должно быть вроде подключено ShellAPI

По-моему, ShellAPI там как раз и не нужен.

А ActiveX, ComObj, ShlObj не помешали бы.

Процедура создания ярлыка

Нет, создать-то ярлык у меня получается...

В той же папке, например.

Проблема скорее в том, как направить ярлык на рабочий стол.

Может, я путь к нему неправильно получаю?!

Вообще, неуверен, нужно ли использовать

CSIDL_DESKTOPDIRECTORY или же CSIDL_DESKTOP?

В принципе, не выходит ничего ни с тем, ни с тем...

Думаю, проблему надо искать где-то в этих строчках:

SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,List);

new(folder);

SHGetPathFromIDList(List,folder);

ChDir(folder);

PathLink := pChar(folder) + 'link.lnk'; //pChar(ExtractFilePath(PathObj)) вставить здесь заместо pCharFolder

Может, я и неправ...

[aTeos]

Ааа все врубился. Ты можешь написать функцию или уже посмотреть готовую здесь (будет работать и в 9х и в NT)

В реестре в ветке HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders есть параметр Desktop, который указывает на папку рабочего стола

Изменено 6 мая, 2004 пользователем aTeos

[Amsterdam]

О-оо-о! Респект огромный! :P

Все заработало прекрасно!!! :)

Спасиб и за помощь и за ссылку на отличный сайт - мигом в 'Избранное' залетел! :lol: :)

Изменено 6 мая, 2004 пользователем Amsterdam

[aTeos]

Пожалуйста ;)

Этот сайт у меня тож в избранном ;)

[Ivanopulo]

Ссылка измененная. Ребята, Я прошу извинить меня, но может подскажите имеется ли возможность создавать ярлыки из BAT файла. Например на рабочий стол. Чиркните пожалуйста рабочий скрипт, например к notepad

[Тролль]

Ivanopulo:

Командный процессор такого не умеет. Через скрипт, вызываемый прямо или из BAT-файла, можно.

Вот, например, на vb script:

set WBSShell = WScript.CreateObject("WScript.Shell")DesktopPath = WBSShell.SpecialFolders("Desktop")set MyShortcut = WBSShell.CreateShortcut(DesktopPath + "\\mspaint.lnk")MyShortcut.TargetPath = WBSShell.ExpandEnvironmentStrings("%windir%\\System32\\mspaint.exe")MyShortcut.WorkingDirectory = WBSShell.ExpandEnvironmentStrings("%windir%")MyShortcut.HotKey = ("CTRL+ALT+P")MyShortcut.WindowStyle = 4MyShortcut.IconLocation = WBSShell.ExpandEnvironmentStrings("%windir%\\System32\\mspaint.exe, 0")MyShortcut.Save()rem WScript.Echo("Done!")

Расширение файла с этим текстом должно быть VBS. Я вызываю тут для примера Paint. Ярлык помещается на рабочий стол. Горячие клавиши для вызова Paint назначены Ctrl+Alt+P. Все это, естественно, легко изменить.

P.S. Забыл, просьба была для notepad. Тогда надо заменить \\mspaint.lnk на \\notepad.lnk, а %windir%\\System32\\mspaint.exe на %windir%\\notepad.exe

Изменено 21 февраля, 2007 пользователем Тролль