创建快捷方式到[启动]

//根据zswang和"超级猛料"部分函数改编

//比放到注册表里麻烦多了

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): 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));

if ExtractFileExt(mFileName) <> '.lnk' then

mFileName := mFileName + '.lnk';

vPersistFile.Save(PWChar(mFileName), False);

except

Result := False;

end;

end;

function CreateLinkToStartUp(AppName, WorkingDirectory,

LinkFileName: String; CurrentUser: Boolean = True): Boolean;

begin

if CurrentUser then //CurrentUser

Result := CreateShellLink(AppName, WorkingDirectory,

GetSpecialFolderDir(CSIDL_STARTUP) + '\' + LinkFileName)

else//All User

Result := CreateShellLink(AppName, WorkingDirectory,

GetSpecialFolderDir(CSIDL_COMMON_STARTUP) + '\' + LinkFileName);

end;

//创建到当前用户的[启动]里,CreateLinkToStartUp中最后一个参数设置为True

//创建到所有用户的启动里,CreateLinkToStartUp中最后一个参数设置为False

//创建到别的用户里,可以修改一下，不过。。。这样做不好吧。。。