registry 为程序创建快捷方式

功能说明：为程序创建快捷方式 
uses registry,ActiveX,Comobj,Shlobj;

const
  IID_IPersistFile: TGUID =
  (D1:$ 0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$ 46));
function GetShellFolder (constfolder: string): string;
const
  cWin32 = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
  cSHellPrefix = '\Explorer\Shell Folders';
var
  r:TRegistry;
begin
  Result := '';
  r :=TRegistry.Create;
  //创建对象
   try
    r.Rootkey :=HKEY_CURRENT_USER;
     //只要是Windows95及其以后版本，此处都一样
    ifr.OpenKey (cWin32 +cShellPrefix, False) then
     //打开键，开始读取
     Result :=r.ReadString (folder) + '\';
   finally
    r.Free;
    //释放创建的对象
   end;
end;

function CreateLink(aPathObj,aPathLink,aDesc: string): boolean;
var
  sLink: IShellLink;
  PersFile: IPersistFile;
begin
  Result :=false;
  ifSUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil,
               CLSCTX_INPROC_SERVER, IID_IShellLinkA, sLink)) then
  //创建接口实例成功
   begin
    sLink.SetPath(PChar(aPathObj));
   //设置要创建快捷方式的程序路径及其文件名
    sLink.SetDescription(PChar(aDesc));
     //设置对快捷方式的描述信息
    if SUCCEEDED(sLink.QueryInterface(IID_IPersistFile,PersFile)) then
     //查询接口成功
     begin
      PersFile.Save(StringToOLEStr(aPathLink),TRUE);
       //保存快捷方式
      Result :=true;
     end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not CreateLink(Application.ExeName,
                    GetShellFolder( 'Desktop') + 'mylink.lnk', '我的快捷方式') then
  //调用GetShellFolder获取系统桌面文件夹路径
   begin
    Showmessage( '创建快捷方式失败');
   end;
end;

通过 Wiz 发布