Criar Alias

Delphi

22/07/2004

Gostaria de uma rotina que verifica se existe um determinado alias (logo na instalação), caso não exista criá-lo, caso já exista, não fazer nada.


Paradox com delphi 7


Facc

Facc

Curtidas 0

Respostas

Aroldo Zanela

Aroldo Zanela

22/07/2004

Colega,

Tem um componente que fiz para outro colega há algum tempo. Veja o fonte abaixo:

{***********************************************
** Aroldo Zanela - aroldo_zanela@hotmail.com
** 2003 - Brasilia - DF - Brasil
** icq: 9271424 (Portuguese and English)
}
unit AddStandardAlias;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  dbTables, ShellAPI, ShlObj;

type
TDefaultDriver = (ddPARADOX,dddBase,ddASCIIDRV);

type
  TAddStandardAlias = class(TComponent)
  private
    { Private declarations }
    FAlias: String;
    FTitleName: String;
    FDefaultDriver: TDefaultDriver;
  protected
    { Protected declarations }
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
  published
    { Published declarations }
    property Alias: String read FAlias write FAlias;
    property TitleName: String read FTitleName write FTitleName;
    property DefaultDriver: TDefaultDriver read FDefaultDriver write FDefaultDriver;
    function IsAlias: Boolean;
    function CatcheDirectory: String;
    Procedure Execute;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Zanela´, [TAddStandardAlias]);
end;

{ TAddStandardAlias }

function TAddStandardAlias.CatcheDirectory: String;
var TitleName: string;
  lpItemID: PItemIDList;
  BrowseInfo: TBrowseInfo;
  DisplayName: array[0..MAX_PATH] of char;
  TempPath: array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), 0);
  BrowseInfo.hwndOwner := Application.Handle;
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := FTitleName;
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    GlobalFreePtr(lpItemID);
    Result := TempPath;
  end else
  Result := ´´;

end;

constructor TAddStandardAlias.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
end;

destructor TAddStandardAlias.Destroy;
begin
inherited Destroy;
end;

procedure TAddStandardAlias.Execute;
var cDefaultDriver, cPath: String;
begin

if (FAlias=´´) or (Session.IsAlias(FAlias)) then exit;

 cPath:= CatcheDirectory;

if not (cPath=´´) then
  begin
    Case FDefaultDriver of
      ddParadox: cDefaultDriver:= ´PARADOX´;
      dddBase: cDefaultDriver := ´dBase´;
      ddAsciiDRV: cDefaultDriver := ´ASCIIDRV´;
    end;
    try
    Session.AddStandardAlias(FAlias, cPath, cDefaultDriver);
    Session.SaveConfigFile;
    Session.Close;
    except
    // Don´t raise any exception.
    end;
  end
end;

function TAddStandardAlias.IsAlias: Boolean;
begin
Result:= Session.IsAlias(FAlias);
end;

end.



GOSTEI 0
POSTAR