//根據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
//創建到別的用戶裡,可以修改一下,不過。。。這樣做不好吧。。。