Home | Chi sono | Contattami
 

Progr. lineare

Delphi
 
Componenti
  Database
 
Miei articoli

Windows

Miei articoli 

 

Componente per la creazione di links


Ecco un componente che ho creato per la realizzazione rapida di Link: pu˛ essere utile ad esempio nel contesto di programmi di installazione per mettere Link sul Desktop oppure nel men¨ Programmi, etc...

unit ShortCut; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComObj, ShlObj, ShellAPI, ActiveX, Menus, ComCtrls, FileCtrl; type TSpecialLocations = (slNone, slDesktop, slFavorites, slFonts, slNetHood, slPersonal, slPrograms, slRecent, slSendTo, slStartMenu, slStartup, slTemplates ); type TShortCut = class(TComponent) private { Private declarations } FIObj : IUnknown; FLink : IShellLink; FIPFile : IPersistFile; FTargetW : WideString; FTarget : string; FArgs : string; FWorkDir : string; FShortCutName : string; FSpecialLocation : TSpecialLocations; function GetSpecialFolderPath(Folder: integer): string; protected { Protected declarations } public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Execute; published { Published declarations } property Target: string read FTarget write FTarget; property Args: string read FArgs write FArgs; property WorkDir: string read FWorkDir write FWorkDir; property ShortCutName: string read FShortCutName write FShortCutName; property SpecialLocation: TSpecialLocations read FSpecialLocation write FSpecialLocation; end; procedure Register; implementation constructor TShortcut.Create(AOwner: TComponent); begin { Creiamo un oggetto ShellLink e ricaviamo 2 riferimenti ad esso rispettivamente di tipo IShellLink e IPersistFile} inherited; FIObj := CreateComObject(CLSID_ShellLink); FLink := FIObj as IShellLink; FIPFile := FIObj as IPersistFile; end; destructor TShortcut.Destroy; begin { Free the ShellLink object. } FIObj := nil; FLink := nil; FIPFile := nil; inherited; end; function TShortcut.GetSpecialFolderPath(Folder: integer): string; var ItemIdList: PItemIdList; CharStr: array[0..MAX_PATH] of Char; Directory: string; Cartelle: string; Index: integer; Lung: integer; begin OleCheck(ShGetSpecialFolderLocation(0, Folder, ItemIdList)); if ShGetPathFromIdList(ItemIdList, CharStr) then begin Index := LastDelimiter('\', FShortCutName); if Index <> 0 then //ci sono sottocartelle begin Cartelle := Copy(FShortCutName, 1, Index - 1); Directory := string(CharStr) + '\' + Cartelle; if not DirectoryExists(Directory) then ForceDirectories(Directory); end; Result := string(CharStr) + '\' + FShortCutName; end; end; procedure TShortCut.Execute; begin with FLink do begin SetPath(PChar(FTarget)); SetArguments(PChar(FArgs)); SetWorkingDirectory(PChar(FWorkDir)); end; case FSpecialLocation of slDesktop : FTargetW := GetSpecialFolderPath(CSIDL_DESKTOPDIRECTORY); slFavorites : FTargetW := GetSpecialFolderPath(CSIDL_FAVORITES); slFonts : FTargetW := GetSpecialFolderPath(CSIDL_FONTS); slNetHood : FTargetW := GetSpecialFolderPath(CSIDL_NETHOOD); slPersonal : FTargetW := GetSpecialFolderPath(CSIDL_PERSONAL); slPrograms : FTargetW := GetSpecialFolderPath(CSIDL_PROGRAMS); slRecent : FTargetW := GetSpecialFolderPath(CSIDL_RECENT); slSendTo : FTargetW := GetSpecialFolderPath(CSIDL_SENDTO); slStartMenu : FTargetW := GetSpecialFolderPath(CSIDL_STARTMENU); slStartup : FTargetW := GetSpecialFolderPath(CSIDL_STARTUP); slTemplates : FTargetW := GetSpecialFolderPath(CSIDL_TEMPLATES); else FTargetW := FShortCutName; end; FIPFile.Save(PWChar(FTargetW),False); end; procedure Register; begin RegisterComponents('Carlo Pasolini', [TShortCut]); end; end.

Esempi di utilizzo:

shTest: TShortCut; ... with shTest do begin SpecialLocation := slStartMenu; //ShortCutName: nome del link (obbligatoria l'estensione .lnk) //Si pu˛ creare un percorso con cartelle e sottocartelle che si //traduce in men¨ e sottomen¨ ShortCutName := 'CarloLINK\sub1\test link\nomelink.lnk'; //Target: file che si vuole aprire tramite il link Target := 'notepad.exe'; //WorkDir: cartella di lavoro WorkDir := 'c:\programmi'; Execute; end;

 

 

 

 
 
Your Ad Here