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.

Comments: Post a Comment



<< Home

This page is powered by Blogger. Isn't yours?