如何用程序创建快捷方式？请各位大虾帮忙，兄弟我肯定给分感激不尽！

Question

//from
http://kingron.myetang.com/zsfunc09.htm(*//
标题:创建快捷方式;获取系统文件或系统目录
说明:参考Kingron资料中“如何取得某些特殊文件夹路径”
设计:Zswang
日期:2002-01-25
支持:[email protected]
//*)///////Begin Source
uses
  ShlObj, ActiveX, ComObj;function GetSpecialFolderDir(mFolder: Integer): string;
{ 返回获取系统文件或系统目录 }
(*
    CSIDL_BITBUCKET         *   回收站
    CSIDL_CONTROLS          *   控制面板
    CSIDL_DESKTOP           *   桌面
    CSIDL_DESKTOPDIRECTORY      桌面目录       //如C:\WINDOWS\Desktop
    CSIDL_DRIVES            *   我的电脑
    CSIDL_FONTS                 字体           //如C:\WINDOWS\FONTS
    CSIDL_NETHOOD               网上邻居目录   //如C:\WINDOWS\NetHood
    CSIDL_NETWORK           *   网上邻居
    CSIDL_PERSONAL              我的文档       //如C:\My Documents
    CSIDL_PRINTERS          *   打印机
    CSIDL_PROGRAMS              程序组         //如C:\WINDOWS\Start Menu\Programs
    CSIDL_RECENT                最近文档       //如C:\WINDOWS\Recent
    CSIDL_SENDTO                发送到         //如C:\WINDOWS\SentTo
    CSIDL_STARTMENU             开始菜单       //如C:\WINDOWS\Start Menu
    CSIDL_STARTUP               启动           //如C:\WINDOWS\启动
    CSIDL_TEMPLATES             模版           //如C:\WINDOWS\ShellNew
*)
var
  vItemIDList: PItemIDList;
  vBuffer: array[0..MAX_PATH] of Char;
begin
  SHGetSpecialFolderLocation(0, mFolder, vItemIDList);
  SHGetPathFromIDList(vItemIDList, vBuffer); //转换成文件系统的路径
  Result := vBuffer;
end; { GetSpecialFolderDir }function CreateShellLink(mPath: string; mWorkingDirectory: string;
  mFileName: WideString): Boolean; { 返回创建快捷方式是否成功 }
var
  vShellLink: IShellLink;
  vPersistFile: IPersistFile;
  vUnKnown: IUnKnown;
begin
  Result := True;
  try
    vUnKnown := CreateComObject(CLSID_ShellLink);
    vShellLink := vUnKnown as IShellLink;
    vPersistFile := vUnKnown as IPersistFile;
    vShellLink.SetPath(PChar(mPath));
    vShellLink.SetWorkingDirectory(PChar(mWorkingDirectory));
    vPersistFile.Save(PWChar(mFileName), False);
  except
    Result := False;
  end;
end; { CreateShellLink }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateShellLink(ParamStr(0), ExtractFilePath(ParamStr(0)),
    GetSpecialFolderDir(CSIDL_DESKTOPDIRECTORY) + '\' +
    ChangeFileExt(ExtractFileName(ParamStr(0)), '.lnk'));
end;
///////End Demo

Answer 1

Visual Studio 5.0光盘中VFP5.0子目录下带一个STKIT432.DLL，其中有一个函数的API如下(Object Pascal 定义)：
fucntion fCreateShellLink(DestPath, LinkName, LinkAppPath, LinkArgs: Pchar): Integer; stdcall; external 'STKIT432.DLL'通过COM自动化的方法创建快捷方式如下：
uses … , ShlObj, ActiveX, ComObj;
procedure CreateShellLink(const DestPath, LinkName, LinkAppPath,
  LinkArgs, Description: String);
Var
 aObj: IUnknown;
 WFileName: WideString;
Begin
 aObj := CreateComObject(CLSID_ShellLink);
 With aObj as IShellLink do begin
   {对MS-DOS程序,一般建议使用SetShowCmd(SW_SHOWMAXIMIZED);}
   SetShowCmd(SW_NORMAL);
   SetArguments(Pchar(LinkArgs));
   SetDescription(Pchar(Description));
   SetPath(Pchar(LinkAppPath));
   SetWorkingDirectory(Pchar(ExtractFilePath(LinkAppPath)));
 End;
 {将一个String赋给WideString，转换过程由Delphi自动完成}
   WFileName := DestPath + '\' + LinkName;
 (aObj as IPersistFile).Save(PWChar(WFileName), False);
End;
     使用CreateShellLink过程要保证路径文件名参数正确，如下：
CreateShellLink('C:\Pwin98\Desktop', '快捷方式名', 'C:\Command.com',
 '', '简短描述');
CreateShellLink('C:\Pwin98\Desktop', 'Win32程序.Lnk', 'D:\Setup.exe', '', '');

Answer 2

Visual Studio 5.0光盘中VFP5.0子目录下带一个STKIT432.DLL，其中有一个函数的API如下(Object Pascal 定义)：
fucntion fCreateShellLink(DestPath, LinkName, LinkAppPath, LinkArgs: Pchar): Integer; stdcall; external 'STKIT432.DLL'通过COM自动化的方法创建快捷方式如下：
uses … , ShlObj, ActiveX, ComObj;
procedure CreateShellLink(const DestPath, LinkName, LinkAppPath,
  LinkArgs, Description: String);
Var
 aObj: IUnknown;
 WFileName: WideString;
Begin
 aObj := CreateComObject(CLSID_ShellLink);
 With aObj as IShellLink do begin
   {对MS-DOS程序,一般建议使用SetShowCmd(SW_SHOWMAXIMIZED);}
   SetShowCmd(SW_NORMAL);
   SetArguments(Pchar(LinkArgs));
   SetDescription(Pchar(Description));
   SetPath(Pchar(LinkAppPath));
   SetWorkingDirectory(Pchar(ExtractFilePath(LinkAppPath)));
 End;
 {将一个String赋给WideString，转换过程由Delphi自动完成}
   WFileName := DestPath + '\' + LinkName;
 (aObj as IPersistFile).Save(PWChar(WFileName), False);
End;
     使用CreateShellLink过程要保证路径文件名参数正确，如下：
CreateShellLink('C:\Pwin98\Desktop', '快捷方式名', 'C:\Command.com',
 '', '简短描述');
CreateShellLink('C:\Pwin98\Desktop', 'Win32程序.Lnk', 'D:\Setup.exe', '', '');