Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Удалить ярлыки, созданные для всех пользователей  (Прочитано 5608 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Shouldercannon
Помогающий

ru
Offline Offline

« : 24-01-2017 14:55 » new

Доброго времени суток.
Была необходимость создать ярлык на рабочем столе и автозапуске для всех учётных записей начиная с Windows XP и до 10
Код: (Delphi)
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;
Теперь это не нужно. Пытаюсь удалить созданные ярлыки
Код: (Delphi)
  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, всё совпадаёт, но файлы не найдены и не удаляются. Где подвох?

Нашёл ошибку. В имени ярлыка есть пробел.
« Последнее редактирование: 24-01-2017 19:01 от Shouldercannon » Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines