Создание ярлыка для конкретного файлаDelphi , Файловая система , ЯрлыкиСоздание ярлыка для конкретного файла
Автор: VID { **** 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 и FreePascal. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |