Постольку поскольку 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;
