Текущий архив: 2005.07.31;
Скачать: CL | DM;

Вниз

Создание ярлыка   Найти похожие ветки 

← →
PIF   (2005-06-04 00:10) [0]

Здравствуйте!
Скажите пожалуйста, как при запуске программы скопировать иконку программы  на рабочий стол, и в меню Пуск-Программы.
Заранее благодарен!!!

---

← →
KilkennyCat ©   (2005-06-04 00:26) [1]

а пояндексогуглить религия, что ли, запрещает? или папа с мамой?

unit Lnk;
{* Additional unit. Has two procedures to get system folder by its CSIDL and
  to create shortcut to the specified file object. Sources are from public place.
  Actually, made on base of sample from MSDN.
  Adapted to use with KOL.  }

interface

uses windows, shlobj, ActiveX,  {OLE2,} KOL;

function CreateLinkDesc(const FileName,Arguments,WorkDir,IconFile:String;
                   IconNumber:integer; LinkName:String;
                   Description:String
                   ): Boolean;
{* Creates a shortcut with description. }

function CreateLink(const FileName,Arguments,WorkDir,IconFile:String;
                   IconNumber:integer; LinkName:String
                   ): Boolean;

implementation

const
 IID_IPersistFile: TGUID = (
   D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

function CreateLink(const FileName,Arguments,WorkDir,IconFile:String;
                   IconNumber:integer; LinkName:String ): Boolean;
begin
 Result := CreateLinkDesc( FileName, Arguments, WorkDir, IconFile, IconNumber,
        LinkName, "" );
end;

function CreateLinkDesc(const FileName,Arguments,WorkDir,IconFile:String;
                   IconNumber:integer; LinkName:String;
                   Description:String): Boolean;
var
 SLink   : IShellLink;
 PFile   : IPersistFile;
 WFileName : WideString;
begin
 Result := FALSE;
 CoInitialize( nil );
 if CoCreateInstance( TGUID( CLSID_ShellLink ), nil, CLSCTX_INPROC_SERVER, TGUID( IID_IShellLinkA ), SLink ) <> S_OK then Exit;
 if SLink.QueryInterface( System.TGUID( IID_IPersistFile ), PFile ) <> S_OK then Exit;
 SLink.SetArguments(PChar(Arguments));
 SLink.SetPath(PChar(FileName));
 SLink.SetWorkingDirectory(PChar(WorkDir));
 SLink.SetDescription(PChar(Description));
 SLink.SetIconLocation(PChar(IconFile),IconNumber);
 if not DirectoryExists(ExtractFilePath(LinkName)) then CreateDir( ExtractFilePath(LinkName) );
 WFileName := LinkName;
 PFile.Save(PWChar(WFileName),False);
 Result := TRUE;
end;

end.

---

← →
Floppy ©   (2005-06-04 10:22) [2]

procedure SetShortCut(path, cmd, icon, wd, name, arg: string);
var
 ShellObject: IUnknown;
 LinkFile: IPersistFile;
 ShellLink: IShellLink;
begin
 try
   CoInitialize(nil);
   ShellObject := CreateComObject(CLSID_ShellLink);
   LinkFile := ShellObject as IPersistFile;
   ShellLink := ShellObject as IShellLink;
   ShellLink.SetPath(@cmd[1]);
   ShellLink.SetWorkingDirectory(@wd[1]);
   ShellLink.SetIconLocation(@icon[1], 0);
     // вместо 0 можно указать номер иконки если их там много...
   ShellLink.SetDescription(@name[1]);
   ShellLink.SetArguments(@arg[1]);
   LinkFile.Save(PWChar(WideString(path)), true);
 finally
   ShellObject := Unassigned;
   CoUninitialize;
 end;
end;
Пример

SetShortCut(
GetSystemPath(DESKTOP), //это рабочий стол
"1",
"MyIco.ico",
"путь откуда запускать", //рабочий каталог, можно и удаленно в сети
"Name",
""путь откуда запускать + project.exe"); //сюда имя выбранного ресурса

---

← →
Abessalom   (2005-06-05 20:49) [3]

> Floppy ©   (04.06.05 10:22) [2]

CoInitializе
CоUninitialize

IMHO, обе эти функции должны находиться в разделах initialization/finalization, но не в рядовой функции (разумеется, если она не будет выполнятся в контексте отдельного потока)

---

Страницы: 1 вся ветка

Текущий архив: 2005.07.31;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.027 c