Проверка наличия ярлыка в Inno Setup

Delphi , Программа и Интерфейс , Инсталяция

Проверка наличия ярлыка в Inno Setup

При создании установщика с помощью Inno Setup может возникнуть потребность проверить наличие ярлыка, указывающего на определенный файл, в определенной папке. Название ярлыка может быть произвольным и не находится под вашим контролем, но вам известно, на какой файл он должен ссылаться. Если ярлык отсутствует, его необходимо создать, а если он уже присутствует, повторно создавать его не нужно.

Одним из возможных решений является проход по всем файлам-ярлыкам в папке и проверка, на какой файл они ссылаются. В комментарии к ответу на вопрос Shared Shortcuts/Icons упоминается интерфейс IShellLink, но как его использовать в секции Code Inno Setup, непонятно (так как Uses ShlObj; не распознается).

В этом материале мы рассмотрим, как проверить наличие ярлыка в Inno Setup и создать его, если он отсутствует, с помощью интерфейса IShellLink.

Подтвержденный ответ:

Базируясь на официальном примере Inno Setup CodeAutomation2.iss и удаленном ответе @TLama к вопросу How to get shortcut target path with InnoSetup, мы можем использовать следующий код:

Требуется Unicode-версия Inno Setup (на данный момент это единственная доступная версия).

Сначала определим некоторые константы и типы данных:

const
  MAX_PATH = 260;
  STGM_READ = $00000000;
  SLGP_SHORTPATH = $1;
  SLGP_RAWPATH = $4;
  SLGP_RELATIVEPRIORITY = $8;
  CLSID_ShellLink = '{00021401-0000-0000-C000-000000000046}';

type
  TWin32FindDataW = record
    //... (остальные поля)
    cFileName: array[0..MAX_PATH-1] of Char;
    cAlternateFileName: array[0..13] of Char;
  end;

  IShellLinkW = interface(IUnknown)
    '{000214F9-0000-0000-C000-000000000046}'
    //... (другие методы)
    function GetPath(pszFile: string; cchMaxPath: Integer;
      var FindData: TWin32FindDataW; fFlags: DWORD): HRESULT;
    //... (другие методы)
  end;

  IPersist = interface(IUnknown)
    '{0000010C-0000-0000-C000-000000000046}'
    function GetClassID(var classID: TGUID): HRESULT;
  end;

  IPersistFile = interface(IPersist)
    '{0000010B-0000-0000-C000-000000000046}'
    //... (другие методы)
    function IsDirty: HRESULT;
    function Load(pszFileName: string; dwMode: Longint): HRESULT;
    function Save(pszFileName: string; fRemember: BOOL): HRESULT;
    function SaveCompleted(pszFileName: string): HRESULT;
    function GetCurFile(out pszFileName: string): HRESULT;
  end;

Далее, создадим функцию GetLinkFileTarget, которая возвращает целевой путь ярлыка:

function GetLinkFileTarget(const FileName: string): string;
var
  FindData: TWin32FindDataW;
  ComObject: IUnknown;
  ShellLink: IShellLinkW;
  PersistFile: IPersistFile;
begin
  //... (код для создания объекта IShellLink и загрузки ярлыка)
  SetLength(Result, MAX_PATH);
  OleCheck(ShellLink.GetPath(Result, MAX_PATH, FindData, SLGP_RAWPATH));
  SetLength(Result, Pos(#0, Result) - 1);
end;

Наконец, создадим процедуру IterateShortcuts, которая проходит по всем файлам-ярлыкам в указанной папке и выводит целевой путь каждого ярлыка в журнал:

procedure IterateShortcuts(Path: string);
var
  FindRec: TFindRec;
  ShortcutPath: string;
  TargetPath: string;
begin
  Path := AddBackslash(Path);

  Log(Format('Looking for .lnk in [%s]', [Path]));

  if FindFirst(Path + '*.lnk', FindRec) then
  begin
    try
      repeat
        ShortcutPath := Path + FindRec.Name;
        TargetPath := GetLinkFileTarget(ShortcutPath);
        Log(Format('Target of shortcut [%s] is [%s]', [
          ShortcutPath, TargetPath]));
      until not FindNext(FindRec);
    finally
      FindClose(FindRec);
    end;
  end;
end;

Теперь вы можете использовать процедуру IterateShortcuts в своем установщике Inno Setup для проверки наличия ярлыка в определенной папке и создания его, если он отсутствует.

Создано по материалам из источника по ссылке.

Материал описывает, как проверить наличие ярлыка в установщике Inno Setup и создать его, если он отсутствует, используя интерфейс IShellLink.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Инсталяция ::