TURBU Tech

Firebird is a great database, but it’s got one really irritating drawback: no native support for the boolean type.  The standard solution to this issue is to create a BOOLEAN domain as a special restricted version of a smallint, and then make your database driver output the correct type.

The first part is easy.  The second, not so much, if you want to use DBExpress.  This really should be handled internally as a special case inside the DBX driver.  Unfortunately neither Embarcadero nor Chau Chee Yang, maker of the alternative dbExpress Firebird driver, has released the source to their drivers, neither driver handles the BOOLEAN domain, and neither driver has any sort of callback/event handler that you can set up to intercept and modify the schema of a query result.  But I’m not gonna let a little thing like that stop me!

To know how to fix this, we first need to know what’s going wrong.  Here’s the basic overview:

To access database data through DBExpress, you generally use TSimpleDataset.  This is a TCustomClientDataset descendant that contains an internal dataset for DB access called TInternalSQLDataSet.  The outer layer has all the functionality that makes TClientDataset wonderful to work with.  You run a query, and it has the internal dataset access the database and pull back data, which gets stuffed into the client dataset for you to manipulate.

When the internal dataset talks to the database, it runs the query and gets back a record set, which includes data and a schema.  It iterates over the schema and prepares field defs for each column, then creates fields based on the field defs.  If you could catch and modify the field defs before it builds fields from them, you’d be good, but the whole process happens inside the InternalOpen method, with no conveniently-placed event handlers for you to interpose any code.

However, the InternalInitFieldDefs method, which sets up the field defs, is virtual, so it can be overridden in a descendant class.  Only problem is, we’re talking about the internal dataset here.  It’s kind of difficult to replace the internal dataset of your TSimpleDataset, because it’s a private field.  But the AllocDataSet method, which sets up the internal dataset, is also virtual.  With a little bit of RTTI surgery, we can set a value to a private field.

Things could get really messy at this point.  I could create a new dataset that descends from TSimpleDataset, but then I’d have to put it in a package, register it on the component palette, etc… unless I use an interposer class, a component with the same name that’s hidden from the form designer but gets instantiated instead of the original class at runtime.  So that’s our starting point.

Here’s my unit, weighing in at just under 100 lines of code plus the MPL header.  I’ll explain how it works at the bottom.  This does require Delphi 2010 or greater.

[code lang="Delphi"]
{*****************************************************************************
* The contents of this file are used with permission, subject to
* the Mozilla Public License Version 1.1 (the "License"); you may
* not use this file except in compliance with the License. You may
* obtain a copy of the License at
* http://www.mozilla.org/MPL/MPL-1.1.html
*
* Software distributed under the License is distributed on an
* "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
* implied. See the License for the specific language governing
* rights and limitations under the License.
*
*****************************************************************************
*
* This file was created by Mason Wheeler.  He can be reached for support at
* tech.turbu-rpg.com.
*****************************************************************************}
unit FirebirdDataset;

interface
uses
   SimpleDS;

type
  TSimpleDataset = class(SimpleDS.TSimpleDataset)
  protected
    procedure AllocDataSet; override;
  end;

implementation
uses
  Classes, SysUtils, RTTI, DB, Provider, SqlExpr,
  DBCommon;

type
  TInternalSQLDataSet = class(SimpleDS.TInternalSQLDataSet)
  private
    FQuery: TSqlQuery;
  protected
    procedure InternalInitFieldDefs; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TSimpleDataset }

procedure TSimpleDataset.AllocDataSet;
var
  ctx: TRttiContext;
  cls: TRttiType;
  fld: TRttiField;
  FDataset: TInternalSQLDataSet;
  FProvider: TDataSetProvider;
begin
  cls := ctx.GetType(self.ClassType);

  fld := cls.GetField('FDataset');
  FDataSet := TInternalSQLDataSet.Create(Self);
  FDataSet.Name := 'InternalDataSet';
  FDataSet.SQLConnection := Connection;
  FDataSet.SetSubComponent(True);
  fld.SetValue(self, FDataset);

  fld := cls.GetField('FProvider');
  FProvider := fld.GetValue(self).AsType;
  FProvider.DataSet := FDataSet;
end;

{ TInternalSQLDataSet }

constructor TInternalSQLDataSet.Create(AOwner: TComponent);
const
  QUERY = 'select rFields.RDB$FIELD_NAME NAME ' +
          'from  RDB$RELATION_FIELDS rFields ' +
          'join RDB$FIELDS fields ON (rFields.RDB$FIELD_SOURCE = fields.RDB$FIELD_NAME) ' +
          'where  (rFields.RDB$RELATION_NAME=:tablename) and (fields.RDB$FIELD_TYPE = 7) ' +
          '  and (rFields.RDB$FIELD_SOURCE = ''BOOLEAN'') ' +
          'order by rFields.RDB$FIELD_POSITION ';
begin
  inherited Create(AOwner);
  FQuery := TSqlQuery.Create(self);
  FQuery.SQL.Text := QUERY;
  FQuery.Params.AddParameter.Name := 'tablename';
end;

procedure TInternalSQLDataSet.InternalInitFieldDefs;
var
  def: TFieldDef;
begin
  inherited InternalInitFieldDefs;
  if not (self.CommandType in [ctTable, ctQuery]) then
    Exit;

  FQuery.Active := false;
  //Why is TCustomSQLDataSet.SetConnection both virtual and private?!?
  FQuery.SQLConnection := self.SQLConnection;
  FQuery.ParamByName('tablename').AsString := UpperCase(GetTableNameFromQuery(self.CommandText));
  FQuery.Active := true;
  FQuery.First;
  FieldDefs.BeginUpdate;
  try
    while not FQuery.Eof do
    begin
      def := TFieldDef(TDefCollection(FieldDefs).Find(Trim(FQuery.FieldByName('NAME').AsString)));
      if assigned(def) then
         def.DataType := ftBoolean;
      FQuery.Next;
    end;
  finally
    FieldDefs.EndUpdate;
  end;
end;

end.[/code]

First comes the outer dataset.  It should operate exactly the same way as the original dataset, except with a modified inner dataset.  So I override AllocDataSet and replace it with a copy of the original code, except that it creates the new internal dataset and uses RTTI to access the private fields.  The internal dataset is where the interesting stuff takes place.

You can find out about Firebird domains by querying the internal metadata tables for the database.  That’s basically the only option available this late in the game, so I gave the new internal dataset an internal dataset of its own, a TSqlQuery which is designed for… well, you can probably guess.  The constructor creates the TSqlQuery and loads it with a parameterized query that will find any columns in a table that belong to a smallint-based domain named BOOLEAN.

Then, when InternalInitFieldDefs runs, it calls the inherited method, then sees if there’s anything it needs to fix.  Currently only single-table queries of type ctTable or ctQuery are supported.  If you run a ctQuery with a join on it, it’ll only get the first table.  Working around this would require building an actual SQL parser into the dataset, and I don’t really have time for that this evening.

It calls the RTL function DBCommon.GetTableNameFromQuery, which uses a very simple SQL parser to extract the table name. (If your query type is ctTable, it’ll just return the same table name you passed in.)  It sets the param on the internal TSqlquery and runs it, and then goes over the results. Any fields that get returned get checked against the field defs and their type is switched to ftBoolean.  Then this function returns, and InternalOpen goes on its merry way, setting up boolean fields for you.  Hooray!

But this really should be handled within the driver.  I hope that that can be arranged for the next version. (Of either one.)  Then we won’t need hacks like this.