//根据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
//创建到别的用户里,可以修改一下，不过。。。这样做不好吧。。。
