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 = 'Software\MicroSoft\Windows\CurrentVersion\Explorer'; 
  QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv'; 
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('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell 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;