Fórum Como manipular Áliases do BDE em Tempo de Execução ? #175310

{***********************************************
** 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.