Удалить ярлыки, созданные для всех пользователей

Модераторы: Duncon, Naeel Maqsudov, Игорь Акопян, Хыиуду

Ответить
Shouldercannon
Сообщения: 74
Зарегистрирован: 08 июн 2008, 15:49

24 янв 2017, 17:54

Доброго времени суток.
Была необходимость создать ярлык на рабочем столе и автозапуске для всех учётных записей начиная с 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, всё совпадаёт, но файлы не найдены и не удаляются. Где подвох?

Нашёл ошибку. В имени ярлыка есть пробел.
Ответить