Главная страница
    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.033 c
6-1085550788
4d696b65
2004-05-26 09:53
2004.07.25
MAC-адрес


8-1084035716
$tranger
2004-05-08 21:01
2004.07.25
Меню как в OFFICE XP


1-1089625590
Max Ivanych
2004-07-12 13:46
2004.07.25
Беда с сообщениями


14-1089079484
Думкин
2004-07-06 06:04
2004.07.25
С днем рождения! 6 июня


1-1089636731
BillyJeans
2004-07-12 16:52
2004.07.25
FileExists();





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский