Создание ярлыка для конкретного файла

Delphi , Файловая система , Ярлыки

Автор: VID
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
ВХОДНЫЕ ПАРАМЕТРЫ.
FILENAME - имя файл ДЛЯ КОТОРОГО будет создан ярлык (*.lnk).
DestDirectory - путь к каталогу, в котором должен быть расположен
создаваемый ярлык.
OverwriteExisting - если TRUE, то в случае существования создаваемого ярлыка
в папке назначения, то существующий ярлык с
подобным именем будет переписан.
AddNumberIfExists - если TRUE, то в при существовании ярлыка с подобным
именем в папке назначения,существующий ярлык не будет переписан, а к
создаваемому ярлыку будет добавлено число, определяющее номер копии
создаваемого ярлыка.

ВНИМАНИЕ !!! Параметр OverwriteExisting является более влиятельным по
отношению к параметру AddNumberIfExists, т.е. при передачи
обоим параметрам TRUE, существующий ярлык
(если таковой имеется в папке назначения),
будет переписан.

Зависимости: shlObj, activeX, SysUtils, filectrl, comObj, UBPFD.ExtractFileNameEX
Автор:       VID, snap@iwt.ru, ICQ:132234868, Махачкала
Copyright:   Списал с одного из FAQ + собственные корректировки и расширение возможностей
Дата:        19 апреля 2002 г.
***************************************************** }

function CreateLink(FileName, DestDirectory: string; OverwriteExisting,
  AddNumberIfExists: Boolean): string;

var
  MyObject: IUnknown;
  MySLink: IShellLink;
  MyPFile: IPersistFile;
  WFileName: WideString;
  X: INTEGER;
begin
  //Изначально RESULT = ''
  Result := '';
  //Если фиайла, для которого создаётся ярлык не существует, или же не
  // существует директории, где должен быть создан ярлык файла, то EXIT
  if (FileExists(FileName) = FALSE) or (DirectoryExists(DestDirectory) = FALSE)
    then
    exit;
  MyObject := CreateComObject(CLSID_SHELLLINK);
  MyPFile := MyObject as IPersistFile;
  MySLink := MyObject as IShellLink;
  with MySLink do
  begin
    SetArguments('');
    SetPath(PChar(FileName));
    SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
  end;

  //Гарантирование проставление завершающего '\' в пути директории
  //расположения создаваемого ярлыка
  if DestDirectory[length(DestDirectory)] <> '\' then
    DestDirectory := DestDirectory + '\';
  // Первичное определене будующего имени ярлыка
  WFileName := DestDirectory + ExtractFileNameEx(FileName, FALSE) + '.lnk';
  //Если ярлык с таким именем уже существует, то
  if (FileExists(WFileName)) then
  begin
    // Если не надо переписывать существующий ярлык, а надо добавить
    // порядковый номер существования к имени создаваемого ярлыка, например
    // blobby1.lnk, blobby2.lnk
    if (OverwriteExisting = FALSE) and (AddNumberIfExists = TRUE) then
    begin
      // Определяем какой именно порядковый номер надо добавить к
      // имени ярлыка
      X := 0;
      repeat
        X := X + 1;
        WFileName := DestDirectory + ExtractFileNameEx(FileName, FALSE)
          + IntToStr(X) + '.lnk';
      until FileExists(WFileName) = FALSE;
      // И сохраняем ярлык
      MyPFile.Save(PWChar(WFileName), FALSE);
      Result := WFileName;
    end;
    //Если надо переписывать существующий ярлык
    if OverwriteExisting = TRUE then
    begin
      //..., то переписываем его :)
      MyPFile.Save(PWChar(WFileName), FALSE);
      Result := WFileName;
    end;
  end
  else
  begin
    //В случае, если ярлыка с подобным имененм ещё нет в папке
    //назначения, то создаём ярлык
    MyPFile.Save(PWChar(WFileName), FALSE);
    Result := WFileName;
  end;
end;

Функция Delphi, именуемая CreateLink, создает ярлык (также известный как ссылка или иконка) для конкретного файла. Функция принимает четыре параметра:

1. FileName: имя файла, для которого создается ярлык.
2. DestDirectory: путь к директории, в которой должен быть создан ярлык.
3. OverwriteExisting: булевое значение, указывающее, нужно ли перезаписать существующий ярлык с тем же именем в 目цестной директории.
4. AddNumberIfExists: булевое значение, указывающее, нужно ли добавить номер к концу имени ярлыка, если он уже существует.

Следующая часть кода:

1. Функция инициализирует некоторые переменные: MyObject - это объект COM, MySLink - интерфейс IShellLink, а MyPFile - интерфейс IPersistFile.
2. Функция проверяет, существует ли файл и директория назначения. Если ни одна из этих условий не истинна, функция сразу же выходит.
3. Функция настраивает свойства ярлыка с помощью интерфейса IShellLink:
   • SetArguments(''): устанавливает аргументы командной строки для ярлыка (не используется в этом случае).
   • SetPath(PChar(FileName)): устанавливает путь к файлу, представляемому ярлыком.
   • SetWorkingDirectory(PChar(ExtractFilePath(FileName))): устанавливает рабочую директорию для ярлыка.
4. Функция проверяет, заканчивается ли директория назначения символом обратной косой черты (\) и добавляет его, если нет.
5. Функция генерирует имя ярлыка на основе имени файла и пути.
6. Если в директории назначения уже существует ярлык с тем же именем, функция проверяет, нужно ли перезаписать или добавить номер к концу имени:
   • Если OverwriteExisting истинно, функция перезаписывает существующий ярлык.
   • Если AddNumberIfExists истинно и OverwriteExisting ложно, функция добавляет номер к концу имени (например, "blobby1.lnk", "blobby2.lnk").
7. Наконец, функция сохраняет ярлык с помощью интерфейса IPersistFile.
8. Функция возвращает путь созданного ярлыка в виде строки.

Создание ярлыка для конкретного файла позволяет создавать shortcut-ы к файлам в различных каталогах.

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

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

:: Главная :: Ярлыки ::