Criar Alias Automatico?
04/12/2003
0
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
gostaria de saber se existe algum comando ou componente pra isso
desde ja agradeço a qualquer resposta
Keliniciante
Curtir tópico
+ 0
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!
(************************************************************)
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
Clique aqui para fazer login e interagir na Comunidade :)