Создаем ярлыки в коде.

На Delphi есть не мало различных вариантов создания ярыков в коде. И в общем-то они рабочие, но только в том случае если писать на средах младше RadStudio 2009.

Постольку поскольку 2009 студия целиком и полностью перешла на юникод, со старыми вариантами создания ярлыка так же возникли проблемы. Пытался всяко разно решить проблему методом бубна над кодом, изменением кодировок вручную и т.п. Потом мне этот беспорядок надоел и нашёл я метод решения построенный на COM объектах. В общем плюс данной реализации в том, что нету тонких мест, которые ломаются при работе со строками. Проверено лично мной, вердикт - работает :)

Источник реализации.

Привожу самую малость модернизированный код:

uses 
  Registry, 
  ActiveX, 
  ComObj, 
  ShlObj; 

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

////////////////////////////////////////////////////////////////////////////////
// Выдает директорию системного меню "Программы" по умолчанию
// так же выдает Application Data текущего пользователя. (нужно для Quik Launch)
function GetProgramDir(GetApp: Boolean = False): string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
    if not GetApp then
      Result := reg.ReadString('Programs')
    else
      Result := reg.ReadString('AppData');
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

function CreateShortcut(SourceFileName: string; // the file the shortcut points to
                        InkName: String; //Имя самого ярлычка (XIO)
                        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 := ChangeFileExt(InkName,'.lnk');//ExtractFileName(LinkName); //XIO Edit

  // 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;