在运行时生成桌面快捷方式

文章出处:来自互联网

作者:未知

 

procedure MakeLink(proName,lnkName,Description,position : String);
var
  WorkDir, DestName: String;
  aReg   : TRegistry;
  aObj   : IUnknown;
  MyLink : IShellLink;
  MyPFile: IPersistFile;
  WFileName: WideString;
begin
    //操作注册表:
    //键'Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders'
    //下的Programs串值指定了Windows启动目录的位置.
  aReg := TRegistry.create;
  aReg.RootKey:=HKey_Current_User;
  aReg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders', False);
  DestName := aReg.ReadString(position) + '/'+lnkName;
  aReg.Closekey;

  aObj := CreateComObject(CLSID_ShellLink);
  MyLink := aObj as IShellLink;
  MyPFile := aObj as IPersistFile;

  WorkDir:= ExtractFilePath(proName);
  with MyLink do //操作IShellLink类
    begin
        //设置显示窗口的类型
      SetShowCmd(SW_NORMAL);
        { 对DOS程序,一般建议使用SetShowCmd(SW_SHOWMAXIMIZED); }
        // 设置命令行参数
      SetArguments('');
        // 设置描述
      SetDescription(pChar(Description));
        // 设置程序名称[全路径,如果在系统Path中,可直接为程文件名]
      SetPath(pChar(proName));
        // 设置工作目录
      SetWorkingDirectory(pChar(WorkDir));
    end;

    //取.LNK文件的位置
  CreateDir(ExtractFilePath(DestName));
    //建立快捷方式: .LNK文件
  WFileName := DestName;  //将一个String赋给WideString，转换过程由Delphi自动完成
  MyPFile.Save(PWChar(WFileName), False);
end;

举例：
MakeLink(Application.ExeName,'iCompanion.lnk','iCompanion','DeskTop');
MakeLink(Application.ExeName,'iCompanion/iCompanion V2.1.lnk','iCompanion','Programs');

 

例子：
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComObj, ShlObj, Activex, StdCtrls;

type
  TfrmMain = class(TForm)
    btnDesktop: TButton;
    procedure btnDesktopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  tmpObject : IUnknown;
  tmpSLink : IShellLink;
  tmpPFile : IPersistFile;
  PIDL : PItemIDList;
  StartupDirectory : array[0..MAX_PATH] of Char;
  LinkFilename : WideString;

implementation

{$R *.dfm}

procedure TfrmMain.btnDesktopClick(Sender: TObject);
begin
    SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
    //获得桌面的ItemIDList
    Fillchar(StartupDirectory,Max_Path+1,0);
    SHGetPathFromIDList(PIDL,StartupDirectory);
    //获得路径
    LinkFilename := StartupDirectory + '/Delphi.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
    //保存*.lnk文件
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    tmpObject := CreateComObject(CLSID_ShellLink);
    //创建建立快捷方式的外壳扩展
    tmpSLink := tmpObject as IShellLink;
    //取得接口
    tmpPFile := tmpObject as IPersistFile;
    //用来储存*.lnk文件的接口
    tmpSLink.SetPath(pChar(Application.ExeName));
    //设定程序所在路径
    tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(Application.ExeName)));
    //设定工作目录
end;

end.
/
也可以在程序组或启动菜单里创建快捷方式，如下（补充上面的代码）：
procedure TfrmMain.btnStartupClick(Sender: TObject);
begin
    SHGetSpecialFolderLocation(0,CSIDL_STARTUP,PIDL);
    Fillchar(startupdirectory,Max_Path+1,0);
    SHGetPathFromIDList(PIDL,StartupDirectory);
    LinkFilename := StartupDirectory + '/Delphi.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
end;

procedure TfrmMain.btnProgramClick(Sender: TObject);
begin
    SHGetSpecialFolderLocation(0,  CSIDL_PROGRAMS,PIDL);
    Fillchar(startupdirectory,Max_Path+1,0);
    SHGetPathFromIDList(PIDL,StartupDirectory);
    if not DirectoryExists(StartupDirectory+'/Delphi') then
    begin
        MkDir(StartupDirectory+'/Delphi');
    end;
    LinkFilename := StartupDirectory + '/Delphi/Delphi.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
end;