Диалог

← →
Kinderr (2003-12-20 15:42) [0]

Как вызвать сабж? Не надо мне расказывать как создавать ярлык программными ср-вами. Мне надо знать как вызывается этот диалог для определённой директории.

← →
Anatoly Podgoretsky (2003-12-20 16:40) [1]

Вызывается он нажатием правой кнопки для определённой директории.

← →
Kinderr (2003-12-20 17:13) [2]

Это понятно. Но меня же не интересует как нажать на меню в эксплорере. Меня интересует как по, скажем, OnClick его вызвать :)

← →
DillerXX (2003-12-20 22:17) [3]

Хм, уважаемые мастера! А не подскажите ли как создавать ярлык программными ср-вами?

← →
Kinderr (2003-12-20 23:11) [4]

// Создание ярлыка для файла (запабликить)
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;

// Создание ярлыка 2
procedure CreateShortcut(const FilePath, ShortcutPath, WorkDir, Description, Params:string);
var obj: IUnknown;
isl: IShellLink;
ipf: IPersistFile;
begin
obj := CreateComObject(CLSID_ShellLink);
isl := obj as IShellLink;
ipf := obj as IPersistFile;
with isl do
begin
SetPath(PChar(FilePath));
SetArguments(PChar(Params));
SetDescription(PChar(Description));
SetWorkingDirectory(PChar(WorkDir));
end;
ipf.Save(PWChar(WideString(ShortcutPath)), False);
end;

Диалог Найти похожие ветки