Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.039 c
14-1089318984
urisan
2004-07-09 00:36
2004.07.25
проблемы с установкой delphi 8


1-1089203408
dosik
2004-07-07 16:30
2004.07.25
Двумерные массивы в испекторе объектов


14-1087913563
cyborg
2004-06-22 18:12
2004.07.25
RoboWarz


14-1089316496
SergP
2004-07-08 23:54
2004.07.25
Почему так?


1-1089730936
FlyDragon
2004-07-13 19:02
2004.07.25
Адрес класса(объекта)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский