Создание ярлыков на рабочем столе, старт меню, панели быстрого запуска

uses
 
  Registry, 
  ActiveX, 
  ComObj, 
  ShlObj; 

type
 
  ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER); 

function
 CreateShortcut(SourceFileName: string
; // the file the shortcut points to 
                        Location: ShortcutType; // shortcut location 
                        SubFolder,  // subfolder of location 
                        WorkingDir, // working directory property of the shortcut 
                        Parameters, 
                        Description: string
): //  description property of the shortcut 
                        string
; 
const
 
  SHELL_FOLDERS_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionExplorer'; 
  QUICK_LAUNCH_ROOT = 'SoftwareMicroSoftWindowsCurrentVersionGrpConv'; 
var
 
  MyObject: IUnknown; 
  MySLink: IShellLink; 
  MyPFile: IPersistFile; 
  Directory, LinkName: string
; 
  WFileName: WideString; 
  Reg: TRegIniFile; 
begin
 

  MyObject := CreateComObject(CLSID_ShellLink); 
  MySLink := MyObject as
 IShellLink; 
  MyPFile := MyObject as
 IPersistFile; 

  MySLink.SetPath(PChar(SourceFileName)); 
  MySLink.SetArguments(PChar(Parameters)); 
  MySLink.SetDescription(PChar(Description)); 

  LinkName := ChangeFileExt(SourceFileName, '.lnk'); 
  LinkName := ExtractFileName(LinkName); 

  // Quicklauch 
  if
 Location = _QUICKLAUNCH then
 
  begin
 
    Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT); 
    try
 
      Directory := Reg.ReadString('MapGroups', 'Quick Launch', ''); 
    finally
 
      Reg.Free; 
    end
; 
  end
 
  else
 
  // Other locations 
  begin
 
    Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT); 
    try
 
    case
 Location of
 
      _OTHERFOLDER : Directory := SubFolder; 
      _DESKTOP     : Directory := Reg.ReadString('Shell Folders', 'Desktop', ''); 
      _STARTMENU   : Directory := Reg.ReadString('Shell Folders', 'Start Menu', ''); 
      _SENDTO      : Directory := Reg.ReadString('Shell Folders', 'SendTo', ''); 
    end
; 
    finally
 
      Reg.Free; 
    end
; 
  end
; 

  if
 Directory <> '' then
 
  begin
 
    if
 (SubFolder <> '') and
 (Location <> _OTHERFOLDER) then
 
      WFileName := Directory + '' + SubFolder + '' + LinkName 
    else
 
      WFileName := Directory + '' + LinkName; 


    if
 WorkingDir = '' then
 
      MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName))) 
    else
 
      MySLink.SetWorkingDirectory(PChar(WorkingDir)); 

    MyPFile.Save(PWChar(WFileName), False
); 
    Result := WFileName; 
  end
; 
end
; 

function
 GetProgramDir: string
; 
var
 
  reg: TRegistry; 
begin
 
  reg := TRegistry.Create; 
  try
 
    reg.RootKey := HKEY_CURRENT_USER; 
    reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders', False
); 
    Result := reg.ReadString('Programs'); 
    reg.CloseKey; 
  finally
 
    reg.Free; 
  end
; 
end
; 

// Some examples: 

procedure
 TForm1.Button1Click(Sender: TObject); 
const
 
 PROGR = 'c:YourProgram.exe'; 
var
 
  resPath: string
; 
begin
 
  //Create a Shortcut in the Quckick launch toolbar 
  CreateShortcut(PROGR, _QUICKLAUNCH, '','','','Description'); 

  //Create a Shortcut on the Desktop 
  CreateShortcut(PROGR, _DESKTOP, '','','','Description'); 

  //Create a Shortcut in the Startmenu /"Programs"-Folder 
  resPath := CreateShortcut(PROGR, _OTHERFOLDER, GetProgramDir,'','','Description'); 
  if
 resPath <> '' then
 
  begin
 
    ShowMessage('Shortcut Successfully created in: ' + resPath); 
  end
; 
end
;

Другое по теме:

• Создать ярлык объекта в любой папке
• Создать ярлык на рабочем столе
• Создание hardlink и symbolic link