Delphi - Creare shortcut catre un fisier sau un director

Delphi - Creare shortcut catre un fisier sau un director

Postby v0id » 23 Jan 2010, 00:04

O metoda simpla pentru a crea un shortcut (.LNK) catre un fisier/director este folosirea interfetelor IShellLink si IPersistFile. IShellLink permite manipularea shortcut-urilor, iar IPersistFile permite salvarea unui obiect intr-un fisier.
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

  1.  
  2. ...
  3. uses ShlObj, ComObj, ActiveX;
  4. ...
  5.  
  6. function CreateShortcut(aSource, aParams, aLinkDir, aLinkName: string;
  7.                         aCreate: boolean): boolean;
  8. var
  9.    lIObject: IUnknown;
  10.    lISLink: IShellLink;
  11.    lIPFile: IPersistFile;
  12.    lPIDL: PItemIDList;
  13.  
  14.    lInFolder: array[0..MAX_PATH] of char;
  15.    lLinkPath: string;
  16. begin
  17.   try
  18.     // Daca parametrul aSource este un string vid, shortcut-ul va fi creat pentru aplicatia noastra
  19.     if (aSource = EmptyStr) then
  20.       aSource := ParamStr(0);
  21.  
  22.     // Instantiere interfete si setare parametri
  23.     lIObject := CreateComObject(CLSID_ShellLink);
  24.  
  25.     lIPFile := lIObject as IPersistFile;
  26.  
  27.     lISLink := lIObject as IShellLink;
  28.     lISLink.SetPath(PChar(aSource));
  29.     lISLink.SetArguments(PChar(aParams));
  30.     lISLink.SetWorkingDirectory(PChar(ExtractFilePath(aSource)));
  31.  
  32.     // Verificam daca ni s-a dat un anumit director care sa contina noul shortcut
  33.     // si daca directorul dat exista
  34.     if (aLinkDir <> EmptyStr) and DirectoryExists(aLinkDir)
  35.       then
  36.         lLinkPath := IncludeTrailingPathDelimiter(aLinkDir) + aLinkName
  37.       else
  38.         begin
  39.           // Nu ni s-a dat un director care sa contina noul shortcut sau directorul dat nu exista
  40.           // Luam calea catre folder-ul Desktop al user-ului curent
  41.           SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, lPIDL) ;
  42.           SHGetPathFromIDList(lPIDL, lInFolder);
  43.  
  44.           // Construim calea completa catre fisierul .LNK
  45.           lLinkPath := IncludeTrailingPathDelimiter(lInFolder) + aLinkName;
  46.         end;
  47.  
  48.     // Ne asiguram ca shortcut-ul are extensia .LNK
  49.     lLinkPath := ChangeFileExt(lLinkPath,'.lnk');
  50.  
  51.     // Verificam daca shortcut-ul trebuie creat sau sters si actionam in consecinta
  52.     if aCreate
  53.       then lIPFile.Save(PChar(lLinkPath), False)
  54.       else DeleteFile(lLinkPath);
  55.  
  56.     Result := True;
  57.   except
  58.     Result := False;
  59.   end;
  60. end;
  61.  
2p / 1 votes
A good coder is never on holiday - he may be working on a different machine, that's about as far as it gets.
User avatar
v0id
Word
 
Joined: 05 Jan 2010
Location: 127.0.0.1
Status: 39.5

Return to Snippets

Who is online

Users browsing this forum: No registered users and 1 guest