Fórum Criar um Alias colocar DBE no Instalador #212183

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