Доброго времени суток.
Была необходимость создать ярлык на рабочем столе и автозапуске для всех учётных записей начиная с Windows XP и до 10
function GetDesktopPath: String;
var
Buffer: Array[0..MAX_PATH] of Char;
begin
if ShGetSpecialFolderPath(Application.Handle, Buffer, CSIDL_COMMON_DESKTOPDIRECTORY, False) then Result := Buffer else Result := '';
end;
function GetStartupPath: String;
var
Buffer: Array[0..MAX_PATH] of Char;
begin
if ShGetSpecialFolderPath(Application.Handle, Buffer, CSIDL_COMMON_STARTUP, False) then Result := Buffer else Result := '';
end;
function CreateShortcut(const CmdLine, Args, WorkDir, LinkFile: String): IPersistFile;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WideFile: WideString;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
with MySLink do
begin
SetPath(PChar(CmdLine));
SetArguments(PChar(Args));
SetWorkingDirectory(PChar(WorkDir));
end;
WideFile := LinkFile;
MyPFile.Save(PWChar(WideFile), False);
Result := MyPFile;
end;
procedure TFormSettings.CBCreateShortcutClick(Sender: TObject);
var
FPath: String;
begin
FPath := Format('%s\%s.lnk', [GetDesktopPath, ProgramName]);
if CBCreateShortcut.Checked then
begin
if not FileExists(FPath) then CreateShortcut(ExtractFilePath(Application.ExeName) + ExtractFileName(Application.ExeName), '', ExtractFilePath(Application.ExeName), FPath);
end
else if FileExists(FPath) then DeleteFile(FPath);
end;
Теперь это не нужно. Пытаюсь удалить созданные ярлыки
Edit1.Text := Format('%s\%s.lnk', [GetDesktopPath, GetField(ConfigFile, '.')]);
if FileExists(Edit1.Text) then
begin
ShowMessage('Ярлык найден');
DeleteFile(Edit1.Text);
end
else ShowMessage('Ярлык не найден');
// Автозагрузка
Edit2.Text := Format('%s\%s.lnk', [GetStartupPath, GetField(ConfigFile, '.')]);
if FileExists(Edit2.Text) then
begin
ShowMessage('Автозапуск найден');
DeleteFile(Edit2.Text);
end
else ShowMessage('Автозапуск не найден');
но нет.
Проверял пути сравнением и через MD5Hash, всё совпадаёт, но файлы не найдены и не удаляются. Где подвох?
Нашёл ошибку. В имени ярлыка есть пробел.