> Hello
>
> I started use embedded Firebird 2.1.1 in my Delphi application (with
> FBLib)
> and I need to create and populate a database file, but if anything goes
> wrong, an exception gets thrown, I need to close and delete the
> database and
> then prompt the user to try again.
>
> The problem is the embedded super-server keeps the newly created
> database

[...]

I don't have this problem. Are you sure you are disconnecting from the
database?
What components are you using?
Alan

I am using FBLib Firbird Library v0.85
http://fblib.altervista.org/

It is a Borland Packaged Library (.bpl) of classes that call isc_ functions
in gds32.dll.

I disconnect from the database and then free the database object:
if (db <> nil) and db.Connected then
begin
db_name := db.DBFile;
db.DBFile := '';
db.Disconnect;
db_service.GFixSetShutDownDb(db_name, 1);
Sleep(1500); // Wait a little for the db to shut down
FreeAndNil(db);
end

The Disconnect method in FBLib, in turn, is:

procedure TFBLDatabase.DoDisconnect;
var
Status_vector: ISC_STATUS_VECTOR;
begin
CheckConnected;
isc_detach_database(@Status_vector, @FDBhandle);

if FDBHandle <> nil then FBLShowError(@Status_vector);
end;

I actually stepped through these lines with the debugger.
You have my fb access code attached if it helps

I would really, really like to know what exactly do you do
that you don't have this problem ?

Thank you,
Timothy Madden,
Romania

----------

unit FirebirdDatabase;
{
< Processes destination database commands and query sets from main app
Uses UTF-8 strings.
}

interface

uses
StdCtrls, JvSpecialProgress, _TreeValues, FBLService, FBLDatabase, FBLExcept,
FBLTransaction, FBLParamDsql, FBLDsql;
type
TFirebirdDatabase = class
protected
var
FBLib: Cardinal; //< Loaded module for fblTurbo
db_service: TFBLService; //< database service manager
// used to take database offline
db: TFBLDatabase; //< database
transact: TFBLTransaction; //< transaction

{ GUI controls to be updated while databse operations are in progress }
FsTxt,FsTxtTotal: TStaticText;
FPrgBar: TJvSpecialProgress;
// Owner: TComponent;

{
Used internally while processing records to update GUI controls
to reflect progress.
}
procedure IncrementTableCounters;

{ used to set parameter values for SQL queries with parameters }
procedure WriteParams
(
query: TFBLParamDsql; // parameterized query
const query_data: TTreeValues; // holds types and values for parameters
const params_node: String // path within data to parameters node
);

{ retrieve output parameter values from query }
procedure ReadParams
(
query: TFBLDsql; // Query with the output fields
query_data: TTreeValues; // list of parametrs and param types
const params_node: String // path to parameters node in query_data
);

{
Executes a query in the current transaction.
SQL statement and input /output parameters
for the query are found in query_data at node
query_node. Output parameters are only set
if returns is True.
}
procedure Exec
(
query_data: TTreeValues;
const query_node: String;
const returns: Boolean
);
public
var
StopExecution: boolean;

destructor Destroy; override;

{
Disconnect from a database after finish working with it.
There is no associated Connect method, use PrepareDatabase
to create a new database and connect to it.
}
procedure Disconnect;
procedure SetCounterControls(sTxt, sTxtTotal: TStaticText; PrgBar: TJvSpecialProgress);
function Connected: boolean;
procedure PrepareDatabase(dbName: WideString);
procedure BeginTrans;
procedure CommitTrans;

{
Execute a batch of queries in a transaction and commit
All strings in Values should be UTF-8
}
function ExecuteQuery
(
Values: TTreeValues; { < Batch of queries and parameters in TreeValues format }
GetResult: boolean = False; { < Indicates query results should be stored back in Values }
SelectCMD: string = ''; { < Index within batch of the query to be executed }
UseCounters: boolean = false; { < Indicates GUI counter controls should be update }
ResetCounters: boolean = false { < Indicates GUI counter controls should be reset first }
):
boolean; overload;

{
Execute a batch of queries in the current transaction.
Queries and query parameters are arranged in Values in the
following format:
Values
- Query1
- SQLString .............. INSERT INTO TableName ...
- ParamsIn
- ParamName
- ParamType ...... vFLOAT
- ParamValue ..... 10.234
- ParamName
- ParamType ...... vBOOLEAN
- ParamValue ..... True
- ...
-
-
- XMLData ................ <?xml><field>TabField</field>...
- Query2
- SQLString .............. UPDATE TableName SET Col = '23' ...
- ParamsIn
- CustomerID
- ParamType ...... vINTEGER
- ParamValue ..... 2034
- XMLData ................ <?xml><result>SUCCESS</result>
- Query3
- ...
- ...
- Error
- Message ................ COMMIT failed: transaction rolled back

Here the XMLData node is set and filled by the function upon return
if GetResult is True

Input strings in Values should be in UTF-8.
Output strings in ParamsOut are UTF-8.
}
Function ADDQuery
(
Values : TTreeValues;
GetResult: boolean = False;
SelectCMD : string = '';
UseCounters : boolean = false;
ResetCounters : boolean = false
):
boolean;

procedure Finalize;
procedure UnloadLibrary;
end;

var
fbDatabase: TFirebirdDatabase;

implementation

uses Windows, Classes, Variants, SysUtils, Forms, ContextTrace,
_dmDatabase, ibase_h;

destructor TFirebirdDatabase.Destroy; // public
begin
if transact <> nil then
if transact.InTransaction then
transact.Rollback;
FreeAndNil(transact);
if db <> nil then
begin
if db.Connected then
db.Disconnect;
FreeAndNil(db)
end;

if db_service <> nil then
begin
db_service.Disconnect;
FreeAndNil(db_service)
end
end;

procedure TFirebirdDatabase.IncrementTableCounters; // protected
begin
FsTxt.Tag := FsTxt.Tag + 1;
FsTxt.Caption := IntToStr(FsTxt.Tag);
FsTxtTotal.Tag := FsTxtTotal.Tag + 1;
FsTxtTotal.Caption := IntToStr(FsTxtTotal.Tag);
FPrgBar.StepIt;
end;

procedure TFirebirdDatabase.SetCounterControls
(
sTxt, sTxtTotal: TStaticText;
PrgBar :TJvSpecialProgress
); // public
begin
FsTxt := sTxt;
FsTxtTotal := sTxtTotal;
FPrgBar := PrgBar;
end;

procedure TFirebirdDatabase.Disconnect; // public
var
db_name: String;
begin
if (transact <> nil) And transact.InTransaction then
transact.Rollback;

FreeAndNil(transact);

if (db <> nil) and db.Connected then
begin
db_name := db.DBFile;
db.DBFile := '';
db.Disconnect;
db_service.GFixSetShutDownDb(db_name, 1);
Sleep(1500); // Wait a little for the db to shut down
FreeAndNil(db);
end
end;

procedure TFirebirdDatabase.UnloadLibrary; // public
var
dll_handle: TLibHandle;
begin
FreeAndNil(transact);
FreeAndNil(db);
FreeAndNil(db_service);
if FBLib <> 0 then
begin
dll_handle := hDLL;
UnloadPackage(FBLib);
end;
FBLib := LoadPackage('fblTurbo.bpl') // Unload and reload the library
end;

procedure TFirebirdDatabase.Finalize; // pubclic
begin
db_service.GFixSetAccessModeReadOnly(db.DBFileName);
end;

function TFirebirdDatabase.Connected: Boolean;
begin
Result := (db <> nil) and db.Connected;
end;


{ Sets parameters for a dynamic SQL query. }
procedure TFirebirdDatabase.WriteParams
(
query: TFBLParamDsql;
const query_data: TTreeValues;
const params_node: String
); // protected
var
Parameters: TStringList;
RaiseMode: Boolean;
ParamPath: String;
varData: Variant;
begin
Parameters := nil;
RaiseMode := query_data.RaiseErrors;
try
Parameters := TStringList.Create;
query_data.RaiseErrors := True;
query_data.ReadSubKeys(params_node, Parameters);

while Parameters.Count > 0 do
begin
ParamPath := params_node + '\' + Parameters[0];
case query_data.ReadInteger(ParamPath, 'ParamType', false) of
vBOOLEAN:
// No boolean type in InterBase 6.0/Firebird 2.1.1
// Assume smallint instead
query.ParamByNameAsShort
(
Parameters[0],
Ord(query_data.ReadBoolean(ParamPath, 'ParamValue', false))
);
vINTEGER:
query.ParamByNameAsLong
(
Parameters[0],
query_data.ReadInteger(ParamPath, 'ParamValue', false)
);
vCURRENCY:
// There are no parameters of type currency in FBLib
query.ParamByNameAsFloat
(
Parameters[0],
query_data.ReadCurrency(ParamPath, 'ParamValue', false) / 1000.0
);
vFLOAT:
query.ParamByNameAsFloat
(
Parameters[0],
query_data.ReadFloat(ParamPath, 'ParamValue', false)
);
vDATETIME:
query.ParamByNameAsDateTime
(
Parameters[0],
query_data.ReadDateTime(ParamPath, 'ParamValue', false)
);
vTIMESTAMP:
query.ParamByNameAsDateTime
(
Parameters[0],
TimeStampToDateTime
(
query_data.ReadTimeStamp(ParamPath, 'ParamValue', false)
)
);
vSTRING:
query.ParamByNameAsString
(
Parameters[0],
query_data.ReadString(ParamPath, 'ParamValue', false)
);
vBLOB:
//AsStream allows for a better implementation,
//but TTreeValues uses String natively anyway
query.BlobParamByNameAsString
(
Parameters[0],
query_data.ReadBlob
(
ParamPath,
'ParamValue',
false
)
);
vVARIANT:
//varData := Variants.Null;
try
varData := query_data.ReadVariant(ParamPath, 'ParamValue', false);
if VarIsArray(varData) then
raise Exception.Create('VarArrays not supported with Firebird database query parameters.');
case VarType(varData) And varTypeMask of
varEmpty,
varNull:
query.ParamByNameAsNull(Parameters[0]);
varByte,
varShortInt,
varSmallint:
query.ParamByNameAsShort(Parameters[0], varData);
varWord,
varInteger:
query.ParamByNameAsLong(Parameters[0], varData);
varLongWord,
varInt64:
query.ParamByNameAsInt64(Parameters[0], varData);
varSingle:
query.ParamByNameAsFloat(Parameters[0], varData);
varDouble:
query.ParamByNameAsDouble(Parameters[0], varData);
varCurrency:
query.ParamByNameAsDouble(Parameters[0], varData/1000.0);
varDate:
query.ParamByNameAsDateTime(Parameters[0], varData);
varOleStr,
varStrArg:
query.ParamByNameAsString
(
Parameters[0],
PChar(UTF8Encode(varData))
);
varString:
query.ParamByNameAsString(Parameters[0], varData);
else
raise Exception.Create('Unsupported VARIANT type given for Firebird database query parameter.')
end
finally
varData := Variants.Null;
end;
else
raise Exception.Create('Unknown parameter type given for query to Firebird database.');
end;

Parameters.delete(0);
end;
finally
query_data.RaiseErrors := RaiseMode;
FreeAndNil(Parameters);
end
end;

procedure TFirebirdDatabase.ReadParams
(
query: TFBLDsql;
query_data: TTreeValues;
const params_node: String
); // protected
var
Parameters: TStringList;
RaiseError: Boolean;
ParamNode: String;
begin
Parameters := nil;
RaiseError := query_data.RaiseErrors;
try
Parameters := TStringList.Create;
query_data.RaiseErrors := True;
query_data.ReadSubKeys(params_node, Parameters);

while Parameters.Count > 0 do
begin
ParamNode := params_node + '\' + Parameters[0];
case query_data.ReadInteger(ParamNode, 'ParamType', false) of
vINTEGER:
query_data.WriteInteger
(
ParamNode,
'ParamValue',
query.FieldByNameAsLong(Parameters[0])
);
vSTRING:
query_data.WriteString
(
ParamNode,
'ParamValue',
query.FieldByNameAsString(Parameters[0])
);
vFLOAT:
query_data.WriteFloat
(
ParamNode,
'ParamValue',
query.FieldByNameAsDouble(Parameters[0])
);
vCURRENCY:
query_data.WriteFloat
(
ParamNode,
'ParamValue',
query.FieldByNameAsDouble(Parameters[0])/1000.0
);
vBOOLEAN:
query_data.WriteBoolean
(
ParamNode,
'ParamValue',
query.FieldByNameAsLong(Parameters[0]) <> 0
);
vDATETIME:
query_data.WriteDateTime
(
ParamNode,
'ParamValue',
query.FieldByNameAsDateTime(Parameters[0])
);
else
raise Exception.Create('Unsupported output parametr type for query to Firebird db.');
end;
Parameters.Delete(0);
end;
finally
query_data.RaiseErrors := RaiseError;
FreeAndNil(Parameters);
end
end;

{
Executes a query in the current transaction and
optionally returns values for output parameters.
}
procedure TFirebirdDatabase.Exec
(
query_data: TTreeValues;
const query_node: String;
const returns: Boolean
); // protected
var
query: TFBLParamDsql;
returns_sql: String;
Parameters: TStringList;
RaiseError: Boolean;
keyField: String;
traceEntry: Context;
sqlStatement: String;
begin
query := nil;
traceEntry := nil;
RaiseError := query_data.RaiseErrors;
try
query_data.RaiseErrors := True;
query := TFBLParamDsql.Create(nil (*Self*));
query.Transaction := transact;
sqlStatement := query_data.ReadString(query_node, 'SQLString', false);
traceEntry := Context.Create(sqlStatement);
query.SQL.Add(sqlStatement);
query.Prepare;
if TdmDatabase.TreeValues_KeyExists(query_data, query_node, 'ParamsIn') then
WriteParams(query, query_data, query_node + '\ParamsIn');
query.ExecSQL;
if
returns
and
TdmDatabase.TreeValues_KeyExists(query_data, query_node, 'ParamsOut')
then
begin
Parameters := nil;
try
Parameters := TStringList.Create;
query_data.ReadSubKeys(query_node + '\ParamsOut', Parameters);

keyField := Parameters[0];
while Parameters.Count > 0 do
begin
if returns_sql <> '' then
returns_sql := returns_sql + ', ';
returns_sql := returns_sql + Parameters[0];
Parameters.Delete(0)
end;

returns_sql :=
'SELECT ' + returns_sql +
' FROM ' +
query_data.ReadString(query_node, 'TableName', false) + ', ' +
'(SELECT MAX(' + keyField + ') AS ReferenceID ' +
'FROM ' + query_data.ReadString(query_node, 'TableName', false) +
') AS ReferenceFields ' +
'WHERE ' + keyField + ' = ReferenceID';
query.UnPrepare;
query.SQL.Clear;
query.SQL.Add(returns_sql);
query.ExecSQL;
query.First;

ReadParams
(
query,
query_data,
query_node + '\ParamsOut'
);
query.Close;
finally
FreeAndNil(parameters);
end
end;
query.UnPrepare;
finally
query_data.RaiseErrors := RaiseError;
FreeAndNil(traceEntry);
FreeAndNil(query);
end
end;

procedure TFirebirdDatabase.CommitTrans; // public
begin
transact.Commit;
end;

procedure TFirebirdDatabase.BeginTrans; // public
begin
if FBLib = 0 then
FBLib := LoadPackage('fblTurbo.bpl');

if transact = nil then
begin
transact := TFBLTransaction.Create(nil (*Self*));
transact.Database := db;
transact.TableReservationMode := rmShared;
end;
transact.StartTransaction;
end;

function TFirebirdDatabase.ADDQuery
(
Values: TTreeValues;
GetResult: Boolean;
SelectCMD: String;
UseCounters: Boolean;
ResetCounters: Boolean
):
Boolean; // public
var
Queries: TStringList;
begin
Queries := nil;
try
if ResetCounters then
FsTXT.Tag := 0;

Application.ProcessMessages;
if SelectCMD <> '' then
Exec(Values, SelectCMD, GetResult)
else
begin
Queries := TStringList.Create;
Values.ReadSubKeys('', Queries);
while (Queries.Count > 0) and (not StopExecution) do
begin
Exec(Values, Queries[0], GetResult);
if UseCounters then
IncrementTableCounters;
Application.ProcessMessages;
Queries.Delete(0);
end
end;
Result := StopExecution
finally
FreeAndNil(Queries)
end
end;

function TFirebirdDatabase.ExecuteQuery
(
Values: TTreeValues;
GetResult: Boolean;
SelectCMD: String;
UseCounters: Boolean;
ResetCounters: Boolean
):
Boolean; // public
begin
try
BeginTrans;
Result :=
ADDQuery
(
Values,
GetResult,
SelectCmd,
UseCounters,
ResetCounters
);
if Result then
CommitTrans
else
transact.RollBack;
finally
if (transact <> nil) and transact.InTransaction then
transact.Rollback
end
end;

procedure TFirebirdDatabase.PrepareDatabase(dbName: WideString); // public
var
trace: Context;
begin
trace := nil;
try
trace := Context.Create('Connecting to Firebird service manager.');
Disconnect;

if FBLib = 0 then
FBLib := LoadPackage('fblTurbo.bpl');

if db_service = nil then
begin
db_service := TFBLService.Create(nil);
db_service.User := 'MediaBase';
db_service.Password := 'MB';
db_service.Protocol := FBLService.ptLocal;
db_service.Connect
end;

trace.Trace('Create Firebird database.');
db := TFBLDatabase.Create(nil (*Self*));
db.CreateDatabase(dbName, 'Mediabase', 'MB', 3, 4096, 'UNICODE_FSS');
if not db.Connected then
begin
db.Protocol := FBLDatabase.ptLocal;
db.DBFile := dbName;
db.User := 'Mediabase';
db.Password := 'MB';
db.CharacterSet := 'UNICODE_FSS';
db.SQLDialect := 3;
db.Connect;
end;
db_service.GFixSetWriteModeAsync(dbName);
finally
FreeAndNil(trace);
if (db <> nil) and not db.Connected then
FreeAndNil(db) // might happen if db.CreateDatabase throws
end;
end;
end.


[Non-text portions of this message have been removed]