Tuesday, January 16, 2007
WinLinks
Aquest component incorpora una sèrie de mètodes que ens permeten crear accesos directes a l'aplicació que el conté.
unit WinLinks;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShlObj, ActiveX, ComObj;
const
CSIDL_DESKTOP = 0;
CSIDL_PROGRAMS = 2;
CSIDL_STARTUP = 7;
CSIDL_STARTMENU = 11;
type
TWinLinks = class(TComponent)
private
{ Private declarations }
Path: string;
Handle: HWnd;
function CreateLink(appname: string; apppath: string): boolean;
protected
{ Protected declarations }
procedure CreateLinkType(linktype: integer);
public
{ Public declarations }
procedure CreateDesktopLink;
procedure CreateStartMenuLink;
procedure CreateStartUpLink;
procedure CreateProgramsLink;
published
{ Published declarations }
end;
procedure Register;
function SHGetSpecialFolderPath(Handle: HWND; Path: PChar; Folder: Integer; Create: Bool): HRESULT; StdCall;
implementation
function SHGetSpecialFolderPath; External 'Shell32.DLL' Name 'SHGetSpecialFolderPathA';
function TWinLinks.CreateLink(appname: string; apppath: string): boolean;
var
IShellLinkInterface: IShellLink;
IPersistFileInterface: IPersistFile;
ResultCode: HResult;
WidePath: Array[0..1024] Of WideChar;
begin
apppath := PChar(apppath);
IShellLinkInterface := IShellLink(CreateCOMObject(CLSID_ShellLink));
With IShellLinkInterface Do
begin
SetPath(pchar(appname));
SetDescription(PChar(ChangeFileExt(ExtractFileName(appname),'')));
end;
StringToWideChar(apppath+'\'+ChangeFileExt(ExtractFileName(appname),'.lnk'), WidePath, 1024);
ResultCode := IShellLinkInterface.QueryInterface(IPersistFile, IPersistFileInterface);
If ResultCode <> S_OK Then // Si no fue posible
begin
Result := False;
Exit;
end;
ResultCode := IPersistFileInterface.Save(WidePath, True);
end;
procedure TWinLinks.CreateLinkType(linktype: integer);
begin
SetLength(Path, MAX_PATH+1);
SHGetSpecialFolderPath(Handle, PChar(Path), linktype, False);
CreateLink(Application.ExeName,Path);
end;
procedure TWinLinks.CreateDesktopLink;
begin
CreateLinkType(CSIDL_DESKTOP);
end;
procedure TWinLinks.CreateStartMenuLink;
begin
CreateLinkType(CSIDL_STARTMENU);
end;
procedure TWinLinks.CreateStartUpLink;
begin
CreateLinkType(CSIDL_STARTUP);
end;
procedure TWinLinks.CreateProgramsLink;
begin
CreateLinkType(CSIDL_PROGRAMS);
end;
procedure Register;
begin
RegisterComponents('Components Delphi', [TWinLinks]);
end;
end.
Els mètodes són CreateDesktopLink, CreateStartMenuLink, CreateStartUpLink i CreateProgramsLink, que ens permeten crear respectivament un accés directe a l'escriptori, al menú Inici, al menú que fa que l'aplicació s'inicïi amb windows i a la secció programes del menú Inici.
# posted by jpuigpelat : 12:27 AM
