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

Вниз

Ярлык на рабочий стол   Найти похожие ветки 

← →
sashapont   (2004-06-12 07:03) [0]

В каком-то 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;

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

---

← →
GuAV ©   (2004-06-12 09:56) [1]

Подправил функцию...
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;

---

← →
GuAV ©   (2004-06-12 10:11) [2]

> 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 10:16) [3]

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

---

← →
sashapont   (2004-06-13 05:24) [4]

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

---

← →
GuAV ©   (2004-06-13 21:14) [5]

> HWND is not type modifier!!!

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

---

← →
sashapont   (2004-06-14 03:11) [6]

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

---

← →
AVK   (2004-06-14 10:46) [7]


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.


---

← →
GuAV ©   (2004-06-14 11:23) [8]

> 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

---

← →
sashapont   (2004-06-15 04:08) [9]

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

---

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

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

Наверх

Память: 0.49 MB
Время: 0.05 c