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;