| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Ярлык на рабочий стол

sashapont ©   (2004-06-12 07:03:00) 

В каком-то FAQ видел процедуру делающую ярлыки
procedure CreateShortcut(const FilePath, ShortcutPath, Description, Params:
string);
var
obj: IUnknown;
isl: IShellLink;
ipf: IPersistFile;
begin
obj := CreateComObject(CLSID_ShellLink);
isl := obj as IShellLink;
ipf := obj as IPersistFile;
with isl do
begin
SetPath(PChar(FilePath));
SetArguments(PChar(Params));
SetDescription(PChar(Description));
end;
ipf.Save(PWChar(WideString(ShortcutPath)), False);
end;

Подскажите плиз как её вызвать, в смысле с какими параметрами

---

sashapont   (2004-06-15 04:08:00) [1]

Пацаны спасибы вам!!! Всё перфектно работает!!!

---

GuAV   (2004-06-14 11:23:00) [2]

> function GetFolder: string;
> var Folder:string;
>    Reg: TRegistry;
> begin
>  Reg:=TRegistry.Create;
>  try
>    Folder:='Desktop'; //StartUp,Cache,Cookies,Favorites,Fonts,
>                       //Personal,Programs,SendTo,Start Menu,Startp
>    Reg.RootKey := HKEY_CURRENT_USER;
>    Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion'+
>                '\Explorer\Shell Folders', False);
>    Result:=Reg.ReadString('Desktop');
>  finally
>    Reg.Free;
>  end;
> end;

SHGetSpecialFolderPath(CSIDL_DESKTOP) :-P

---

AVK   (2004-06-14 10:46:00) [3]


unit main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Label1: TLabel;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses
 ComObj, ShlObj, ActiveX, Registry;

function GetFolder: string;
var Folder:string;
   Reg: TRegistry;
begin
 Reg:=TRegistry.Create;
 try
   Folder:='Desktop'; //StartUp,Cache,Cookies,Favorites,Fonts,
                      //Personal,Programs,SendTo,Start Menu,Startp
   Reg.RootKey := HKEY_CURRENT_USER;
   Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion'+
               '\Explorer\Shell Folders', False);
   Result:=Reg.ReadString('Desktop');
 finally
   Reg.Free;
 end;
end;

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;
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var path: string;
begin
path := GetFolder+'\mylink.lnk';
label1.caption:=path;
CreateLink(Application.EXEName,path,'','');
end;

end.


---

sashapont   (2004-06-14 03:11:00) [4]

To GuAV А вопрос-то был у меня КАК ЭТО ВЫЗВАТЬ, подскажи плиз!!!

---

GuAV   (2004-06-13 21:14:00) [5]

> HWND is not type modifier!!!

HWND is not a type identifier ???
Замени HWND на LongWord. Лично у меня работает.
Только она создаёт ярлык к раб столу, а не на раб стол.
Для ярлыка на раб стол используй SHGetSpecialFolderPath и приведенную тобой функцию.

---

sashapont   (2004-06-13 05:24:00) [6]

To GuAV не не рабочая твоя процедура пишет HWND is not type modifier!!!

---

GuAV   (2004-06-12 10:16:00) [7]

Всё! теперь точно проснулся. sashapont, нужен ярлык не крабочему столу, а нарабочий стол? тогда твоя процедура рабочая, а как правильно использовать - думай сам, тренируйся изучать чужой код...

---

GuAV   (2004-06-12 10:11:00) [8]

> procedure CreateShortcut(H: HWND; const CSIDL: LongWord;
> ShortcutPath, Description, Params:
> string); overload;

procedure CreateShortcut(H: HWND; CSIDL: LongWord; const ShortcutPath, Description, Params:
string); overload;
(и вообще зря я так, вино не проснулся, надо было так:
RTFM IShellLink, IShellLink::SetIDList )

---

GuAV   (2004-06-12 09:56:00) [9]

Подправил функцию...
procedure CreateShortcut(H: HWND; const CSIDL: LongWord; ShortcutPath, Description, Params:
string); overload;
var
 obj: IUnknown;
 isl: IShellLink;
 ipf: IPersistFile;
 mem: IMalloc;
 pidl: PItemIDList;
begin
 obj := CreateComObject(CLSID_ShellLink);
 isl := obj as IShellLink;
 ipf := obj as IPersistFile;
 if SHGetMalloc(mem)=NOERROR then
   with isl do
   begin
     SHGetSpecialFolderLocation(H,CSIDL,pidl);
     //SetPath(PChar(FilePath));
     SetIDList(pidl);
     SetArguments(PChar(Params));
     SetDescription(PChar(Description));
     mem.Free(pidl);
   end;
 ipf.Save(PWChar(WideString(ShortcutPath)), False);
end;

---

Наверх