Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Firebird e Interbase (https://www.clubdelphi.com/foros/forumdisplay.php?f=19)
-   -   Prodimientos de conexión (a quien le sirva......) (https://www.clubdelphi.com/foros/showthread.php?t=3533)

buitrago 10-09-2003 19:02:34

Prodimientos de conexión (a quien le sirva......)
 
Es más, te mando un archivo que tiene los procedures, con ello cuando lo ejecutes la primera vez te va a pedir la dir de la daabase, y no lo pedirá más.

El escribe un archivo que se nombra registroNOMBRE DEL PROYECTO.dat, que se pone en la raíz del disco, en el cual guarda la dirección que obtuvo de la primera vez, despues, solo tienes que levantar el programa y ya no te pregunta más

Hay que ponerlo en el menú del sistema y claro, declarar esta function

------------------------------------------------------------------------
function Tform_Menu.func_CONECTAR:Boolean;
type
TArticulo = record
FileName : String[255];
FileDate : TDateTime;
End;

var
v_Appl : TArticulo;
v_temp_SystemTime : SystemTime;
f_Appl : file Of TArticulo;
c_FileName : String;
const const_Drives: array[1..5] of String = (
'C:\', 'D:\', 'E:\', 'F:\', 'G:\');

var v_Servidor,
v_Ruta,
v_Database,
v_File,
v_Temp,
v_Coneccion: String;
v_Local,Conectado,v_Conecto : Boolean;
v_pos_Servidor,i : Integer;
Begin
v_Conecto := False;
c_FileName := 'c:\registro' + Copy(ExtractFileName(Application.ExeName),1,(pos('.',ExtractFileName(Application.ExeName))-1)) + '.dat';
if FileExists(c_FileName) then Begin
v_Conecto := True;
AssignFile(f_Appl,c_FileName);
Reset(f_Appl);
Read(f_Appl,v_Appl);
CloseFile(f_Appl);
With DatosDatabase.IBDatabase1 Do Begin
DatabaseName := v_Appl.FileName;
Params.Clear;
Params.Add('user_name=SYSDBA');
Params.Add('Password=masterkey');
DatosDatabase.IBDatabase1.LoginPrompt := false;
Try
Open;
except
v_Conecto := False;
ShowMessage('Por alguna razón no se pudo abrir conectar la Database que se queria, consulte con los analistas de sistemas');
End;
End;
Result := v_Conecto;
End
Else
if Not(v_Conecto) then Begin
Conectado := False;
if DatosDatabase.OpenDialog1.Execute then Begin
v_Temp := DatosDatabase.OpenDialog1.FileName;
if (v_Temp[1] = '\') and (v_Temp[2] = '\') then
v_Local := False Else v_Local := True;
if Not(v_Local) then Begin
v_File := ExtractFileName(v_Temp);
v_Temp := Copy(v_Temp,3,length(v_Temp));
v_pos_Servidor := pos('\',v_Temp);
v_Servidor := Copy(v_Temp,1,(v_pos_Servidor-1));
v_Ruta := ExtractFilePath(v_Temp);
v_Ruta := Copy(v_Ruta,(v_pos_Servidor+1),length(v_Ruta));
i := 1;
repeat
v_Coneccion := v_Servidor + ':' + const_Drives[i] + v_Ruta + v_File;
DatosDatabase.IBDatabase1.DatabaseName := v_Coneccion;
try
DatosDatabase.IBDatabase1.Params.Add('user_name=SYSDBA');
DatosDatabase.IBDatabase1.Params.Add('Password=masterkey');
DatosDatabase.IBDatabase1.LoginPrompt := false;
DatosDatabase.IBDatabase1.Open;
Conectado := True;
except
inc(i);
Conectado := False;
End;
until (Conectado = True) Or (i>5);
End
Else
Begin
v_Coneccion := DatosDatabase.OpenDialog1.FileName;
DatosDatabase.IBDatabase1.DatabaseName := v_Coneccion;
try
DatosDatabase.IBDatabase1.Params.Add('user_name=SYSDBA');
DatosDatabase.IBDatabase1.Params.Add('Password=masterkey');
DatosDatabase.IBDatabase1.LoginPrompt := false;
DatosDatabase.IBDatabase1.Open;
Conectado := True;
except
inc(i);
Conectado := False;
End;
End;
if Conectado then Begin
AssignFile(f_Appl,c_FileName);
ReWrite(f_Appl);
v_Appl.FileName := v_Coneccion;
v_Appl.FileDate := NOW;
try
Write(f_Appl,v_Appl);
except
ShowMessage('No se ha podido registrar');
end;
try
CloseFile(f_Appl);
except
ShowMessage('Para colmos no se pudo cerrar el Archivo de Registro');
Halt;
end;
End;
Result := Conectado;
End;
End;
end;
----------------------------------------------------------------------
procedure Tform_Menu.FormCreate(Sender: TObject);
begin
if Not(func_CONECTAR) then
ShowMessage('No se ha podido conectar a la Base de datos');
end;
function


La franja horaria es GMT +2. Ahora son las 22:44:53.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi