创建快捷方式到[启动]
uses ActiveX, ComObj, ShlObj;
function CreateLinkToStartUp(AppName, WorkingDirectory,
LinkFileName,
Description: string; CurrentUser: Boolean = True):
Boolean;
//******************************************************************************
//
Function: 在开始启动里建立程序快捷方式
// Param: AppName string
目标
// WorkingDirectory string 起始位置
//
LinkFileName string 快捷方式名
// Description
string 备注
// CurrentUser
//
创建到当前用户的启动里,CurrentUser设置为True
//
创建到所有用户的启动里,CurrentUser设置为False
// Return: Boolean True :成功 False
:失败
//******************************************************************************
function
GetSpecialFolderDir(const folderid: integer): string;
var
pidl:
pItemIDList;
buffer: array[0..255] of char;
begin
//取指定的目录项目表
//CSIDL_STARTUP:启动
SHGetSpecialFolderLocation(application.Handle, folderid, pidl);
SHGetPathFromIDList(pidl, buffer); //转换成文件系统的路径
Result :=
strpas(buffer);
end;
function CreateShellLink(mPath: string;
mWorkingDirectory: string;
mFileName: WideString; mDescription: string):
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));
vShellLink.SetDescription(PChar(mDescription));
if
ExtractFileExt(mFileName) <> '.lnk' then
mFileName := mFileName
+ '.lnk';
vPersistFile.Save(PWChar(mFileName), False);
except
Result := False;
end;
end;
begin
if CurrentUser
then //CurrentUser
Result := CreateShellLink(AppName,
WorkingDirectory,
GetSpecialFolderDir(CSIDL_STARTUP) + '\' +
LinkFileName, Description)
else //All User
Result :=
CreateShellLink(AppName, WorkingDirectory,
GetSpecialFolderDir(CSIDL_COMMON_STARTUP) + '\' + LinkFileName,
Description);
end;