Criar Alias Automatico?

04/12/2003

1

Gostaria de saber amigos como se cria Alias Automatico Para que Em Qualquer caminho que eu possa Abrir o meu programa ele Abra e funcione normalmente sem da Erro de Bde

gostaria de saber se existe algum comando ou componente pra isso

desde ja agradeço a qualquer resposta


Responder

Posts

04/12/2003

Lucas Silva

Tente esse Código....

(************************************************************)

program AddAlias;

uses
Windows, SysUtils, BDE;

var
// nome do Alias
GAlias: string = ´Teste´;

//aqui você coloca o tipo do Alias, se é PARADOX, ACCESS....
GDriver: string = szMSACCESS;
//aqui você coloca o caminho do banco de dados....
GAliasDir: string = ´meubd.mdb´;
FParams: string;
FDrvName: string;
FDelete: boolean;
i: integer;

function StrToOem(const AnsiStr: string): string;
begin
SetLength(Result, Length(AnsiStr));
if Length(Result) > 0 then
CharToOem(PChar(AnsiStr), PChar(Result));
end;


{----------------------------------------------------------------------------------------}
begin
for i := 1 to ParamCount do
begin
case i of
1: GAlias := ParamStr(1);
2: GAliasDir := ParamStr(2);
3: GDriver := ParamStr(3);
end;
end;

//default alias
if GAliasDir = ´´ then GAliasDir := ExtractFilePath(ParamStr(0))+´Data´;

//should delete alias first? separate alias name
if GAlias[1] = ´-´ then
begin
FDelete := True;
//GAlias := Copy(GAlias, 1, Length(GAlias)); Bug
Delete(GAlias, 1, 1); //Fix by Savierhs Lopez Artega
end else FDelete := False;

FDrvName := GDriver;
//set Parameters, the driver and server name
if (CompareText(GDriver, szCFGDBSTANDARD) = 0) or
(CompareText(GDriver, szPARADOX) = 0) or
(CompareText(GDriver, szDBASE) = 0) or
(CompareText(GDriver, szFOXPRO) = 0) or
(CompareText(GDriver, szASCII) = 0) then
begin
if (CompareText(GDriver, szCFGDBSTANDARD) = 0) then FDrvName := szPARADOX;

//set parameters for the new alias
FParams := Format(´¬s:´¬s´´, [szCFGDBPATH, GAliasDir]) +
Format(´;¬s:´¬s´´, [szCFGDBDEFAULTDRIVER, GDriver]) +
Format(´;¬s:´¬s´´, [szCFGDBENABLEBCD, szCFGFALSE]);
end else begin
if (CompareText(GDriver, ´INTRBASE´) = 0)
then FParams := Format(´¬s:´¬s´´, [szSERVERNAME, GAliasDir])
else FParams := Format(´¬s:´¬s´´, [szDATABASENAME, GAliasDir]);

//add other Parameters here !!!!!!!!!!!!!!!!!
end;

DbiInit(nil);
try
if FDelete then
try
DbiDeleteAlias(nil, PChar(GAlias));
except
end;

try
DbiAddAlias(nil, PChar(StrToOem(GAlias)),
PChar(StrToOem(FDrvName)),
PChar(FParams), True);
DbiCfgSave(nil, nil, True);
except
end;

finally
DbiExit();
end;

end.


(***********************************************************)

mais detalhes em http://www.jrsoftware.org/iskb.php?a=bde

Espero ter Ajudado!
Lucas!


Responder
×
+1 DevUP
Acesso diário, +1 DevUP
Parabéns, você está investindo na sua carreira