How to create a Data Abstract Driver (Delphi)

Overview

This article will show you how to create DA drivers for Delphi. The first part of the article reviews the creation of a simple driver which can only connect to one database. The second part of the article explains how to create drivers which allow connections to several databases.

Creating a simple driver

To create an Aducom SQLite Driver, which will allow connecting to the SQLite database via the SQLite components from Aducom, proceed as follows:

Create a new library. Change the extension from DLL to DAD and put the ShareMem unit as first item into the project's "uses" clause:

library DASQLiteDrv;

uses
  ShareMem,
  uDAServerInterfaces,
  uDASQLiteDriver in 'uDASQLiteDriver.pas';

{$E dad}

{$R *.res}
{$R DASQLiteDriverHtml.res}

exports GetDriverObject name func_GetDriverObject;

end.

Each driver should contain the following classes:

Let's consider the methods of the TDAEDriver. Methods with * are required and should be implemented in the descendant.

Implementation for the SQLite driver:

  TDAEAducomSQLiteDriver = class(TDASQLiteBaseDriver, IDADriver40)
  protected
    function GetConnectionClass: TDAEConnectionClass; override;

    // IDADriver
    function GetDriverID: string; override;
    function GetDescription: string; override;

    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
  public
  end;

…

function TDAEAducomSQLiteDriver.GetConnectionClass: TDAEConnectionClass;
begin
  Result := TDAEAducomSQLiteConnection;
end;

function TDAEAducomSQLiteDriver.GetDescription: string;
begin
  Result := 'SQLite Driver';
end;

function TDAEAducomSQLiteDriver.GetDriverID: string;
begin
  Result := 'SQLite';
end;

procedure TDAEAducomSQLiteDriver.GetAuxParams(const AuxDriver: string;
  out List: IROStrings);
begin
  inherited;
  List.Add('TransactionType=(DEFAULT,DEFERRED,IMMEDIATE,EXCLUSIVE)');
  List.Add('DriverDll=SQLite3.dll');
  List.Add('CharacterEncoding=(STANDARD,UTF8)');
end;

The following methods of TDAEConnection can be overridden. Methods with * are required.

Implementation of TDAEAducomSQLiteConnection:

  TDAEAducomSQLiteConnection = class(TDASQLiteBaseConnection)
  private
    fTransactionFlag: Boolean;
    fConnection: TSQLiteConnection;
    fCharset: TDASQLiteCharset;
  protected
    // TDAEConnection
    function CreateCustomConnection: TCustomConnection; override;
    function GetDatasetClass: TDAEDatasetClass; override;
    procedure SetConnected(Value: Boolean); override;
    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;
    function DoBeginTransaction: Integer; override;
    procedure DoCommitTransaction; override;
    procedure DoRollbackTransaction; override;
    function DoGetInTransaction: Boolean; override;
    function DoGetLastAutoIncValue(const GeneratorName: string): Variant; override;
  public
    constructor Create(aDriver: TDAEDriver; aName: string = ''); override;
  end;

…

procedure TDAEAducomSQLiteConnection.DoApplyConnectionString(
  aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
var
  sName, sValue: string;
  i: Integer;
begin
  inherited;
  TSQLiteConnection(aConnectionObject).Connection.Database := aConnStrParser.Database;
  for i := 0 to (aConnStrParser.AuxParamsCount - 1) do begin
    sName := aConnStrParser.AuxParamNames[i];
    sValue := aConnStrParser.AuxParams[sName];
    if AnsiSameText(sName, 'TransactionType') then begin
      if AnsiSameText(sValue, 'DEFAULT') or
        AnsiSameText(sValue, 'DEFERRED') or
        AnsiSameText(sValue, 'IMMEDIATE') or
        AnsiSameText(sValue, 'EXCLUSIVE') then
        fConnection.fConnection.TransactionType := AnsiUpperCase(sValue);
    end
    else if AnsiSameText(sName, 'DriverDll') then begin
      fConnection.fConnection.DriverDll := sValue
    end
    else if AnsiSameText(sName, 'CharacterEncoding') then begin
      if AnsiSameText(sValue, 'STANDARD') or
        AnsiSameText(sValue, 'UTF8') then
        fConnection.fConnection.CharacterEncoding := AnsiUpperCase(sValue);
    end;
  end;
end;

function TDAEAducomSQLiteConnection.DoBeginTransaction: Integer;
begin
  Result := -1;
  fConnection.Connection.StartTransaction;
  fTransactionFlag := True;
end;

procedure TDAEAducomSQLiteConnection.DoCommitTransaction;
begin
  fConnection.Connection.Commit;
  fTransactionFlag := False;
end;

function TDAEAducomSQLiteConnection.CreateCustomConnection: TCustomConnection;
begin
  fConnection := TSQLiteConnection.Create(nil);
  Result := fConnection;
end;

function TDAEAducomSQLiteConnection.GetDatasetClass: TDAEDatasetClass;
begin
  Result := TDAEAducomSQLiteQuery;
end;

procedure TDAEAducomSQLiteConnection.SetConnected(Value: Boolean);
begin
  inherited;
  if Value then begin
    if fConnection.Connection.Database <> '' then
      fCharset := SQLite_GetCharset(TDAEAducomSQLiteQuery.CreateNative(Self) as IDAServerDataset);
  end;
end;

procedure TDAEAducomSQLiteConnection.DoRollbackTransaction;
begin
  fTransactionFlag := False;
  fConnection.Connection.RollBack;
end;

function TDAEAducomSQLiteConnection.DoGetInTransaction: Boolean;
begin
  Result := fTransactionFlag;
end;

constructor TDAEAducomSQLiteConnection.Create(aDriver: TDAEDriver;
  aName: string);
begin
  inherited;
  fTransactionFlag := False;
end;

function TDAEAducomSQLiteConnection.DoGetLastAutoIncValue(const GeneratorName: string): Variant;
begin
  Result := fConnection.Connection.GetLastInsertRow;
end;

Note: that the Aducom SQLite library doesn't have a a descendant from TCustomConnection wherefore we will create a wrapper:

  TSQLiteConnection = class(TDAConnectionWrapper)
  private
    fConnection: TDAASQLite3DB;
  protected
    function GetConnected: Boolean; override;
    procedure SetConnected(Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Connection: TDAASQLite3DB read fConnection;
  end;

…
constructor TSQLiteConnection.Create(AOwner: TComponent);
begin
  inherited;
  fConnection := TDAASQLite3DB.Create(nil);
end;

destructor TSQLiteConnection.Destroy;
begin
  inherited;
  FreeOrDisposeOf(fConnection);
end;

function TSQLiteConnection.GetConnected: Boolean;
begin
  Result := fConnection.Connected;
end;

procedure TSQLiteConnection.SetConnected(Value: Boolean);
begin
  fConnection.Connected := Value;
end;

Here are methods of TDAEDataset. Methods with * are required.

Our implementation of TDAEDataset:

  TDAEAducomSQLiteQuery = class(TDAEDataset, IDAMustSetParams)
  private
    fNative: Boolean;
  protected
    function CreateNativeDatabaseAccess: IDANativeDatabaseAccess; override;
    procedure ClearParams; override;
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    procedure DoPrepare(Value: Boolean); override;
    function DoExecute: Integer; override;
    function DoGetSQL: string; override;
    procedure DoSetSQL(const Value: string); override;
    procedure SetParamValues(AParams: TDAParamCollection); override;
    procedure GetParamValues(AParams: TDAParamCollection); override;
  public
    constructor CreateNative(aConnection: TDAEConnection);
  end;
…

procedure TDAEAducomSQLiteQuery.ClearParams;
begin
  inherited;
  TASQLite3Query(Dataset).Params.Clear;
end;

function TDAEAducomSQLiteQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  Result := TASQLite3Query.Create(nil);
  TASQLite3Query(Result).Connection := TDAEAducomSQLiteConnection(aConnection).fConnection.Connection;
end;

constructor TDAEAducomSQLiteQuery.CreateNative(aConnection: TDAEConnection);
begin
  Create(aConnection);
  fNative := True;
end;

function TDAEAducomSQLiteQuery.CreateNativeDatabaseAccess: IDANativeDatabaseAccess;
begin
{$IFDEF UNICODE}
  if not fNative then
    Result := TDAAducomNativeDatabaseAccess_Dataset.Create(Self)
  else
{$ENDIF}
    Result := inherited CreateNativeDatabaseAccess;
end;

function TDAEAducomSQLiteQuery.DoExecute: Integer;
begin
  Result := -1;
  TASQLite3Query(Dataset).ExecSQL;
end;

function TDAEAducomSQLiteQuery.DoGetSQL: string;
begin
  Result := TASQLite3Query(Dataset).SQL.Text;
end;

procedure TDAEAducomSQLiteQuery.DoPrepare(Value: Boolean);
begin
  // nothing
end;

procedure TDAEAducomSQLiteQuery.DoSetSQL(const Value: string);
begin
  TASQLite3Query(Dataset).SQL.Text := Value;
end;

procedure TDAEAducomSQLiteQuery.GetParamValues(AParams: TDAParamCollection);
begin
  GetParamValuesStd(AParams, TASQLite3Query(Dataset).Params);
end;

procedure TDAEAducomSQLiteQuery.SetParamValues(AParams: TDAParamCollection);
begin
  SetParamValuesStd(AParams, TASQLite3Query(Dataset).Params);
end;

These are methods of TDAEStoredProcedure. Some from them are similar to TDAEDataset and described above, except:

SQLite doesn't support stored procedures, therefore we skip this section.

Finally, we should create a component for the IDE and estabilsh support for loading the driver dynamically:

  TDASQLiteDriver = class(TDADriverReference)
  end;
…
procedure Register;
function GetDriverObject: IDADriver; stdcall;

implementation

var
  _driver: TDAEDriver = nil;

procedure Register;
begin
  RegisterComponents(DAPalettePageName, [TDASQLiteDriver]);
end;

function GetDriverObject: IDADriver;
begin
  if (_driver = nil) then _driver := TDAEAducomSQLiteDriver.Create(nil);
  Result := _driver;
end;

…

initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);
finalization
  UnregisterDriverProc(GetDriverObject);
  FreeOrDisposeOfAndNil(_driver);
end.

Note: we put this code to .dpr for possibility to load this driver to Schema Modeler:

exports GetDriverObject name func_GetDriverObject;

Creation of drivers which allow connecting to several databases

In this part, we review drivers which have several aux drivers. We will use the Zeos driver as an example. Firstly, we have to specify doAuxDriver:

function TDAEZeosDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
begin
  Result := [doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom];
end;

In GetAuxDrivers, we have to return a list with aux drivers:

procedure TDAEZeosDriver.GetAuxDrivers(out List: IROStrings);
var
  i, j: Integer;
  lDrivers: IZCollection;
  Protocols: TStringDynArray;
begin
  inherited;
  lDrivers := ZDbcIntfs.DriverManager.GetDrivers;
  for i := 0 to lDrivers.Count - 1 do begin
    Protocols := (lDrivers[I] as IZDriver).GetSupportedProtocols;
    for J := Low(Protocols) to High(Protocols) do
      List.Add(Protocols[J]);
  end;
  List.Sorted := True;
end;

In DoApplyConnectionString, we store the current aux driver for later usage in other methods:

procedure TDAEZeosConnection.DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
..
  fDriverName := aConnStrParser.AuxDriver;
  fDriverType := ZEOSDriverIdToZEOSDriverType(aConnStrParser.AuxDriver);

In general, we can use standard functions of DAC, but sometimes they may return incomplete information or we may already have specific methods which return the required information. Therefore, we can use custom methods for some functions:

procedure TDAEZeosConnection.DoGetTableFields(const aTableName: string;
  out Fields: TDAFieldCollection);
var
  lschema, ltbl: string;
  fld: TDAField;
  lz: IZResultSet;
begin
  case fDriverType of
    dazMSSQL: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields, fIsAzure);
    dazInterBase: IB_GetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields, fIsFBServer);
    dazMySQL: MYSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields, fNativeConnection.fConnection.Catalog, GetMySQLVersion);
    dazOracle: Oracle_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
    dazPostgreSQL: Postgres_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields, GetCharset = 'UTF8');
    dazSQLite:     SQLite_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
  else
    if (fDriverType = dazADO) and (fADOProviderType in [oledb_MSSQL, oledb_MSSQL2005]) then
      MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields, fIsAzure)
    else begin
      inherited;
      if Pos('.', aTableName) > 0 then begin
        lschema := Trim(Copy(aTableName, 1, Pos('.', aTableName) - 1));
        ltbl := Trim(Copy(aTableName, Pos('.', aTableName) + 1, Length(aTableName)));
      end
      else begin
        lschema := '';
        ltbl := aTableName;
      end;
      // required+default value
      lz := ZEOS_GetMetadata.GetColumns(fNativeConnection.fConnection.Catalog, lschema, ltbl, '');
      while lz.Next do begin
        fld := Fields.FindField(lz.GetUnicodeStringByName('COLUMN_NAME'));
        if fld = nil then Continue;
        fld.Required := lz.GetUnicodeStringByName('IS_NULLABLE') = 'NO';

        fld.DefaultValue := lz.GetUnicodeStringByName('COLUMN_DEF');
        if not TestDefaultValue(fld.DefaultValue, fld.DataType) then
          fld.DefaultValue := '';
      end;
      lz.Close;
      // pk
      lz := ZEOS_GetMetadata.GetPrimaryKeys(fNativeConnection.fConnection.Catalog, lschema, ltbl);
      while lz.Next do begin
        fld := Fields.FindField(lz.GetUnicodeStringByName('COLUMN_NAME'));
        if fld = nil then Continue;
        fld.Required := True;
        fld.InPrimaryKey := True;
      end;
      lz.Close;
    end;
  end;
  FixWideStringBug(Fields);
end;

We have attached a template which you can use for creating drivers: driver_template.zip