Форум: "Система";
Текущий архив: 2002.09.16;
Скачать: [xml.tar.bz2];

Вниз

Доступ к ярлыкам на рабочем столе.   Найти похожие ветки 

← →
Linc   (2002-07-04 01:53) [0]

Мне надо получить доступ к рабочему столу винды или к ярлыкам на рабочем столе. Помогите!!!

---

← →
perov   (2002-07-04 10:32) [1]

данная процедура создает ярлык в определенной папке на рабочем столе (информация для ярлыка беертся из VersionInfo), обрати внимание на GetSorcutPathName - возвращает программу, на которую ссылается ярлык и почитай интерфейсы
IShellLink, IPersistFile

procedure CreateShortcut;
procedure CreateDesktopShortcut(FileName, linkname, Directory: string);
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WFileName: WideString;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
with MySLink do
begin
SetPath(PChar(FileName));
SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
end;
WFileName := Directory + linkname + ".lnk";
MyPFile.Save(PWChar(WFileName), False);
end;

function GetShortcutPathName(const LinkFile: WideString): string;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
str: array[0..MAX_PATH] of Char;
FindData: TWin32FindData;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
MyPFile.Load(PWideChar(LinkFile), STGM_READ);
with MySLink do begin
Resolve(0, SLR_ANY_MATCH or SLR_NO_UI);
GetPath(str, MAX_PATH, FindData, SLGP_UNCPRIORITY);
Result := str;
end;
end;

var
sr: TSearchRec;
Path: array[0..MAX_PATH] of Char;
Found: Boolean;
OrigFileName, FileDesc, Directory: string;
begin
with TVersionInfo.Create(ParamStr(0)) do begin
OrigFileName := OriginalFileName;
FileDesc := FileDescription;
Free;
end;
SHGetSpecialFolderPath(0, Path, CSIDL_DESKTOP, False);
if not DirectoryExists(AnsiUpperCase(Path + "\Пенсионный фонд")) then CreateDir(Path + "\Пенсионный фонд");
Directory := Path + "\Пенсионный фонд\";
Found := False;
if FindFirst(Directory + "*.lnk", faAnyFile, sr) = 0 then
begin
repeat
if (AnsiCompareText(sr.Name, FileDesc + ".lnk") = 0) and
(AnsiCompareText(GetShortcutPathName(Directory + sr.Name), ParamStr(0)) = 0) then Found := True
else if ((AnsiCompareText(sr.Name, FileDesc + ".lnk") <> 0) and
(AnsiCompareText(GetShortcutPathName(Directory + sr.Name), ParamStr(0)) = 0))
or ((AnsiCompareText(sr.Name, FileDesc + ".lnk") = 0) and
(AnsiCompareText(GetShortcutPathName(Directory + sr.Name), ParamStr(0)) <> 0))
then DeleteFile(Directory + sr.Name);
until FindNext(sr) <> 0;
FindClose(sr);
end;
if not Found then CreateDesktopShortcut(ParamStr(0), FileDesc, Directory);
end;

---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2002.09.16;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.441 c