Delphi 創建快捷方式函數：CreateShortcut 完整實現

Shell API 創建 .lnk 快捷方式：支援桌面、指定目錄、特殊文件夾 (CSIDL)

封裝 IShellLink/IPersistFile COM 接口，實現創建快捷方式通用函數 CreateShortcut，支援自定義名稱、目標目錄、系統特殊文件夾常數。

函數簽名

function CreateShortcut(Exe: string; Lnk: string = ''; Dir: string = ''; ID: Integer = -1): Boolean;
{Exe: 目標文件(必填)  Lnk: 快捷方式名(默認同目標)  Dir: 目標目錄(默認桌面)  ID: CSIDL 常數(優先於 Dir)}

核心實現

uses ShlObj, ActiveX, ComObj;

function CreateShortcut(Exe, Lnk, Dir: string; ID: Integer): Boolean;
var IObj: IUnknown; ILnk: IShellLink; IPFile: IPersistFile;
    PIDL: PItemIDList; InFolder: array[0..MAX_PATH] of Char; LinkFileName: WideString;
begin
  Result := False;
  if not FileExists(Exe) then Exit;
  if Lnk = '' then Lnk := ChangeFileExt(ExtractFileName(Exe), '');

  IObj := CreateComObject(CLSID_ShellLink);
  ILnk := IObj as IShellLink;
  ILnk.SetPath(PChar(Exe));
  ILnk.SetWorkingDirectory(PChar(ExtractFilePath(Exe)));

  if (Dir = '') and (ID = -1) then ID := CSIDL_DESKTOP;
  if ID > -1 then begin
    SHGetSpecialFolderLocation(0, ID, PIDL);
    SHGetPathFromIDList(PIDL, InFolder);
    LinkFileName := Format('%s\%s.lnk', [InFolder, Lnk]);
  end else begin
    Dir := ExcludeTrailingPathDelimiter(Dir);
    if not DirectoryExists(Dir) then Exit;
    LinkFileName := Format('%s\%s.lnk', [Dir, Lnk]);
  end;

  IPFile := IObj as IPersistFile;
  if IPFile.Save(PWideChar(LinkFileName), False) = 0 then Result := True;
end;

四種調用測試

procedure TForm1.Button1Click(Sender: TObject);  {桌面創建，默認名}
begin CreateShortcut(Application.ExeName); end;

procedure TForm1.Button2Click(Sender: TObject);  {桌面創建，自定義名}
begin CreateShortcut(Application.ExeName, 'NewLinkName'); end;

procedure TForm1.Button3Click(Sender: TObject);  {C:\ 根目錄創建}
begin CreateShortcut(Application.ExeName, '', 'C:\'); end;

procedure TForm1.Button4Click(Sender: TObject);  {開始菜單程序文件夾}
begin CreateShortcut(Application.ExeName, '', '', CSIDL_PROGRAMS); end;

常用 CSIDL： CSIDL_DESKTOP、CSIDL_PROGRAMS、CSIDL_STARTMENU、CSIDL_STARTUP、CSIDL_PERSONAL (我的文檔) 等。