怎样在已知目录下创建当前应用程序的快捷方式

Question

怎样在已知目录下创建当前应用程序的快捷方式

Answer 1

在程序单元的uses语句中
要加入ComObj、ActiveX和ShlObj这三个单元。 　　procedure CreateLink(ProgramPath, ProgramArg, LinkPath, Descr: Str
ing); 　　其中，ProgramPath是快捷方式的目标文件的全路径（包括文件名和路径）；
ProgramArg是目标文件的参数；LinkPath是快捷方式的全路径；Descr是对此快捷
方式的描述。 　　在单元的实现部分加入以下代码： 
　　procedure CreateLink(ProgramPath, ProgramArg, LinkPath, Descr: String); 
　　var 
　　 AnObj: IUnknown; 
　　 ShellLink: IShellLink; 
　　 AFile: IPersistFile; 
　　 FileName: WideString; 
　　begin 
　　 if UpperCase(ExtractFileExt(LinkPath)) 〈〉 ′.LNK′ then //检查扩展名是否正确 
　　 begin 
　　 raise Exception.Create(′快捷方式的扩展名必须是 ′′LNK′′!′);//若不是则产生异常 
　　 end; 
　　 try 
　　OleInitialize(nil);//初始化OLE库，在使用OLE函数前必须调用初始化 
　　AnObj := CreateComObject(CLSID—ShellLink);//根据给定的ClassID生成一个COM对象，此处是快捷方式 
　　ShellLink := AnObj as IShellLink;//强制转换为快捷方式接口 
　　AFile := AnObj as IPersistFile;//强制转换为文件接口 
　　//设置快捷方式属性，此处只设置了几个常用的属性 
　　ShellLink.SetPath(PChar(ProgramPath)); // 快捷方式的目标文件，一般为可执行文件 
　　ShellLink.SetArguments(PChar(ProgramArg));// 目标文件参数 
　　ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(ProgramPath)));//目标文件的工作目录 
　　ShellLink.SetDescription(PChar(Descr));// 对目标文件的描述 
　　FileName := LinkPath;//把文件名转换为WideString类型 
　　AFile.Save(PWChar(FileName), False);//保存快捷方式 
　　 finally 
　　OleUninitialize;//关闭OLE库，此函数必须与OleInitialize成对调用 
　　 end; 
　　end;  
　　procedure TForm1.Button1Click(Sender: TObject); 　　var 　　 tmp: array [0..MAX—PATH] of Char; 　　 WinDir: string; 　　begin 　　 GetWindowsDirectory(tmp,MAX—PATH); 　　 WinDir:=String(tmp); 　　 if Length(WinDir) 〉 3 then 　　 WinDir:=WinDir＋′\′;//得到Windows的目录 　　 //在桌面上放置本程序的快捷方式 
    //你要改的效果就在这里.你写入就可以就可以把他放到指定的目录了.
　　 CreateLink(ParamStr(0),′′,WinDir＋′desktop\′＋Application.Tit
le＋′.lnk′,′Application.Title′); 　　end; 

Answer 2

unit Unit1; interface uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs,ShlObj,ActiveX,ComObj; type 
  TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; var 
  Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var 
  tmpObject  :  IUnknown;  
  tmpSLink  :  IShellLink; 
  tmpPFile  :  IPersistFile; 
  s  :  String; 
  LinkFilename  :  WideString;   begin 
  tmpObject  :=  CreateComObject(CLSID_ShellLink);//创建建立快捷方式的外壳扩展 
  tmpSLink  :=  tmpObject  as  IShellLink;//取得接口  
  tmpPFile  :=  tmpObject  as  IPersistFile;//用来储存*.lnk文件的接口 
  tmpSLink.SetPath(pChar(ParamStr(0))); 
  S:= GetEnvironmentVariable('userprofile')+'\'+'「开始」菜单\程序\启动'; 改成你指定的目录
  LinkFilename  :=  S  +  '\zw.lnk'; 
  tmpPFile.Save(pWChar(LinkFilename),FALSE);//保存*.lnk文件   Inherited;    //加上这句 
  end; 
end.