Mai jos aveti functia CreateShortcut, cu ajutorul careia puteti crea un shortcut folosind aceste interfete.
Parametri CreateShortcut:
aSource - fisierul/directorul pentru care vom crea shortcut-ul
aParams - parametrii utilizati la deschiderea fisierului folosind shortcut-ul
aLinkDir - directorul in care va fi creat shortcut-ul; daca se da un string vid, se va folosi Desktop-ul user-ului curent
aLinkName - numele shortcut-ului
aCreate - daca este True, se va crea shortcut-ul; daca este False, shortcut-ul va fi sters (daca exista)
Rezultat CreateShortcut:
True - crearea/stergerea shortcut-ului s-a efectuat cu succes
False - s-a intalnit o exceptie
- ...
- uses ShlObj, ComObj, ActiveX;
- ...
- function CreateShortcut(aSource, aParams, aLinkDir, aLinkName: string;
- aCreate: boolean): boolean;
- var
- lIObject: IUnknown;
- lISLink: IShellLink;
- lIPFile: IPersistFile;
- lPIDL: PItemIDList;
- lInFolder: array[0..MAX_PATH] of char;
- lLinkPath: string;
- begin
- try
- // Daca parametrul aSource este un string vid, shortcut-ul va fi creat pentru aplicatia noastra
- if (aSource = EmptyStr) then
- aSource := ParamStr(0);
- // Instantiere interfete si setare parametri
- lIObject := CreateComObject(CLSID_ShellLink);
- lIPFile := lIObject as IPersistFile;
- lISLink := lIObject as IShellLink;
- lISLink.SetPath(PChar(aSource));
- lISLink.SetArguments(PChar(aParams));
- lISLink.SetWorkingDirectory(PChar(ExtractFilePath(aSource)));
- // Verificam daca ni s-a dat un anumit director care sa contina noul shortcut
- // si daca directorul dat exista
- if (aLinkDir <> EmptyStr) and DirectoryExists(aLinkDir)
- then
- lLinkPath := IncludeTrailingPathDelimiter(aLinkDir) + aLinkName
- else
- begin
- // Nu ni s-a dat un director care sa contina noul shortcut sau directorul dat nu exista
- // Luam calea catre folder-ul Desktop al user-ului curent
- SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, lPIDL) ;
- SHGetPathFromIDList(lPIDL, lInFolder);
- // Construim calea completa catre fisierul .LNK
- lLinkPath := IncludeTrailingPathDelimiter(lInFolder) + aLinkName;
- end;
- // Ne asiguram ca shortcut-ul are extensia .LNK
- lLinkPath := ChangeFileExt(lLinkPath,'.lnk');
- // Verificam daca shortcut-ul trebuie creat sau sters si actionam in consecinta
- if aCreate
- then lIPFile.Save(PChar(lLinkPath), False)
- else DeleteFile(lLinkPath);
- Result := True;
- except
- Result := False;
- end;
- end;
Welcome to BitCell. Click here to register !