怎样用iShellLink生成快捷方式？

Question

我用VB制作了一个串口通信的程序，但打不上包。所以自己用DELPHI制作了一个安装程序，但是不知道怎样创建快捷方式，请各位高手指教。

Answer 1

uses Registry,ShlObj,ActiveX,ComObj;//定义快捷方式存放位置桌面,发送,开始菜单
type 
  ShortcutType=(_DESKTOP,_QUICKLAUNCH,_SENDTO,_STARTMENU);procedure CreateShortcut(
 FileName: string;//执行文件名,全路径 
 description: string;/快捷方式描述
 arguments: string;//参数
 Location: ShortcutType //存放位置
);
var
MyObject:IUnknown;
MySLink:IShellLink;
MyPFile:IPersistFile;
Directory,LinkName:string;
WFileName:WideString;
MyReg,
QuickLaunchReg:TRegIniFile;
begin 
 MyObject:=CreateComObject(CLSID_ShellLink);//创建com对象
 MySLink:=MyObject as IShellLink;//转化为IShellLink接口
 MyPFile:=MyObject as IPersistFile;//转化为IPersistFile接口
 MySLink.SetPath(PChar(FileName));//设置执行文件名
 MySLink.SetArguments(PChar(arguments));//设置执行参数
 MySLink.SetDescription(PChar(Description));//设置描述
 MySLink.SetWorkingDirectory(PChar(ExtractFilePath(application.exename)));//设置工作路径为执行程序所在目录
 //取存放位置的实际目录
 MyReg:=TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');
 try
  LinkName:=ChangeFileExt(FileName,'.lnk');//生成快捷方式文件名
  LinkName:=ExtractFileName(LinkName);//取文件主名
  Case Location of
   _DESKTOP    :Directory:=MyReg.ReadString('Shell Folders','Desktop','');
   _STARTMENU  :Directory:=MyReg.ReadString('Shell Folders','Start Menu','');
   _SENDTO     :Directory:=MyReg.ReadString('Shell Folders','SendTo','');
   _QUICKLAUNCH:
   begin
     QuickLaunchReg:=TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\GrpConv');
     try
       Directory:=QuickLaunchReg.ReadString('MapGroups','Quick Launch','');
     finally
       QuickLaunchReg.Free;
     end;
   end;
  end;
  if Directory<>'' then begin
   WFileName:=Directory+'\'+LinkName;//合成存放快捷方式文件全路径名
   MyPFile.Save(PWChar(WFileName),False);//保存快捷文件
  end;
 finally
  MyReg.Free;
 end;
end;

Answer 2

再给你一个例子：
unit ShCutF;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    EditName: TEdit;
    Label1: TLabel;
    Button2: TButton;
    GroupBox1: TGroupBox;
    cbDir: TCheckBox;
    cbDesktop: TCheckBox;
    cbStartMenu: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}uses
  ComObj, ActiveX, ShlObj, Registry;procedure TForm1.Button1Click(Sender: TObject);
var
  AnObj: IUnknown;
  ShLink: IShellLink;
  PFile: IPersistFile;
  FileName: string;
  WFileName: WideString;
  Reg: TRegIniFile;
begin
  的两个接口
  AnObj := CreateComObject (CLSID_ShellLink);
  ShLink := AnObj as IShellLink;
  PFile := AnObj as IPersistFile;
  FileName := ParamStr (0);  ShLink.SetPath (PChar (FileName));
  ShLink.SetWorkingDirectory (PChar (
    ExtractFilePath (FileName)));  //将文件保存在当前目录里
  if cbDir.Checked then
  begin
    WFileName := ExtractFilePath (FileName) +
      EditName.Text + '.lnk';
    PFile.Save (PWChar (WFileName), False);
  end;  // 保存在桌面
  if cbDesktop.Checked then
  begin
    Reg := TRegIniFile.Create(
      'Software\MicroSoft\Windows\CurrentVersion\Explorer');
    WFileName := Reg.ReadString ('Shell Folders', 'Desktop', '') +
      '\' + EditName.Text + '.lnk';
    Reg.Free;
    PFile.Save (PWChar (WFileName), False);
  end;  // 保存在开始菜单里
  if cbStartMenu.Checked then
  begin
    Reg := TRegIniFile.Create(
      'Software\MicroSoft\Windows\CurrentVersion\Explorer');
    WFileName := Reg.ReadString ('Shell Folders', 'Start Menu', '') +
      '\' + EditName.Text + '.lnk';
    Reg.Free;
    PFile.Save (PWChar (WFileName), False);
  end;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  ProjectFile: string;
begin
  ProjectFile := ChangeFileExt (ParamStr (0), '.dpr');
  SHAddToRecentDocs (SHARD_PATH, PChar(ProjectFile));
end;end.