(*//

标题:创建快捷方式;获取系统文件或系统目录

说明:参考Kingron资料中"如何取得某些特殊文件夹路径"

设计:Zswang

日期:2002-01-25

支持:wjhu111@21cn.com

//*)

///////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