创建快捷方式到[启动]

最新推荐文章于 2024-05-10 01:52:09 发布

最新推荐文章于 2024-05-10 01:52:09 发布 · 72 阅读

本文介绍了一种在Windows系统中创建程序启动项快捷方式的方法。通过Delphi代码实现，可以根据需求选择放置在当前用户或所有用户的启动文件夹，并提供详细的步骤和函数说明。

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;