unit Unit1;
interface
System.SysUtils, System.Classes, IBDatabase, Data.DB, IBQuery,
Windows, IBHeader,
IB, IBIntf, IBCustomDataSet;
type
TForm1 =
class(TForm)
TestDB: TIBDatabase;
Button1: TButton;
procedure Button3Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
function CheckIBDBStatus(
DB: TIBDatabase;
var ErrCode : Integer): Boolean;
var
Form1 : TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var
ErrorVal : Integer;
begin
TestDB.DatabaseName := '
Server:c:\Test\Test1.gdb';
TestDB.LoginPrompt := False;
TestDB.Params.Add('
USER_NAME=TEST');
TestDB.Params.Add('
password=test');
if CheckIBDBStatus(TestDB, ErrorVal)
then
TestDB.Connected := true
else
Begin
TestDB.DatabaseName := '
Server:c:\Test\Test2.gdb';
TestDB.Connected := true;
end;
TestDB.Connected := False;
end;
function CheckIBDBStatus(
DB: TIBDatabase;
var ErrCode : Integer): Boolean;
{$REGION 'GenerateDPB'}
procedure GenerateDPB(_DB: TIBDatabase; sl: TStrings;
var DPB: AnsiString;
var DPBLength: Short);
var
i, j, pval: Integer;
DPBVal: UShort;
ParamName, ParamValue: AnsiString;
begin
{ The DPB is initially empty, with the exception that
the DPB version must be the first byte of the string. }
DPBLength := 1;
DPB := AnsiChar(isc_dpb_version1);
{Iterate through the textual database parameters, constructing
a DPB on-the-fly }
for i := 0
to sl.Count - 1
do
begin
{ Get the parameter's name and value from the list,
and make sure that the name is all lowercase with
no leading 'isc_dpb_' prefix
}
if (Trim(sl.Names[i]) = '
')
then
continue;
ParamName := AnsiString(LowerCase(sl.Names[i]));
{mbcs ok}
ParamValue := AnsiString(Copy(sl[i], Pos('
=', sl[i]) + 1, Length(sl[i])));
{mbcs ok} {do not localize}
if (Pos(AnsiString(DPBPrefix), ParamName) = 1)
then {mbcs ok}
Delete(ParamName, 1, Length(DPBPrefix));
{ We want to translate the parameter name to some Integer
value. We do this by scanning through a list of known
database parameter names (DPBConstantNames, defined above) }
DPBVal := 0;
{ Find the parameter }
for j := 1
to isc_dpb_last_dpb_constant
do
if (ParamName = AnsiString(DPBConstantNames[j]))
then
begin
DPBVal := j;
break;
end;
{ A database parameter either contains a string value (case 1)
or an Integer value (case 2)
or no value at all (case 3)
or an error needs to be generated (case else) }
case DPBVal
of
isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_sql_role_name,
isc_dpb_sql_dialect, isc_dpb_instance_name, isc_dpb_old_file_name,
isc_dpb_sys_encrypt_password:
begin
if DPBVal = isc_dpb_sql_dialect
then
ParamValue[1] := AnsiChar(Ord(ParamValue[1]) - 48);
DPB := DPB + AnsiChar(DPBVal) + AnsiChar(Length(ParamValue)) + ParamValue;
Inc(DPBLength, 2 + Length(ParamValue));
if DPBVal = isc_dpb_lc_ctype
then
begin
// _DB.CharacterSet := String(ParamValue);
// _DB.SetCodePage;
end;
end;
isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write,
isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify,
isc_dpb_online_dump, isc_dpb_overwrite, isc_dpb_old_file_size:
begin
DPB := DPB + AnsiChar(DPBVal) + #1 + AnsiChar(StrToInt(
String(ParamValue)));
Inc(DPBLength, 3);
end;
isc_dpb_sweep:
begin
DPB := DPB + AnsiChar(DPBVal) + #1 + AnsiChar(isc_dpb_records);
Inc(DPBLength, 3);
end;
isc_dpb_sweep_interval:
begin
pval := StrToInt(
String(ParamValue));
DPB := DPB + AnsiChar(DPBVal) + #4 + PAnsiChar(@pval)[0] + PAnsiChar(@pval)[1] +
PAnsiChar(@pval)[2] + PAnsiChar(@pval)[3];
Inc(DPBLength, 6);
end;
isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
isc_dpb_quit_log:
begin
DPB := DPB + AnsiChar(DPBVal) + #1 + #0;
Inc(DPBLength, 3);
end;
else
begin
if (DPBVal > 0)
and
(DPBVal <= isc_dpb_last_dpb_constant)
then
IBError(ibxeDPBConstantNotSupported, [DPBConstantNames[DPBVal]])
else
IBError(ibxeDPBConstantUnknownEx, [sl.Names[i]]);
end;
end;
end;
end;
{$ENDREGION}
Var
FGDSLibrary : IGDSLibrary;
FDPB : AnsiString;
FDPBLength : short;
Begin
result := False;
FGDSLibrary :=
DB.GDSLibrary;
GenerateDPB(
DB,
DB.Params, FDPB, FDPBLength);
ErrCode :=
DB.Call(FGDSLibrary.isc_attach_database(StatusVector, Length(AnsiString(
DB.DatabaseName)),
PAnsiChar(AnsiString(
DB.DatabaseName)), @
DB.Handle,
FDPBLength, PByte(FDPB)), False);
if ErrCode = 0
then
Result := true;
end;
end.