[翻译]Writing Custom DB Engines 编写定制的DB引擎

Writing Custom DB Engines  编写定制的DB引擎

 

FastReport can build reports not only with data sourced from a Delphi application but also from data sources (connections to DBs, queries) created within the report itself. FastReport comes with engines for ADO, BDE, IBX, DBX and FIB. You can create your own engine and then connect it to FastReport.

FastReport打造的报表,数据不仅源自Delphi应用程序的数据,也可以来自报表自身创建的数据源(连接数据库,查询)。FastReport自带数据引擎ADO,BDE,IBX,DBX 和FIB。你可以创建你自己的数据引擎,然后将它连接到FastReport。

 

The illustration below shows the class hierarchy required for creating DB engines. New engine components are highlighted in green.

下图显示了创建数据库引擎所需的类层次结构。新引擎组件在绿色中高亮显示

_img2

A standard set of DB engine components includes Database, Table and Query. You can create all of these components or just some of them (for example many DBs have no component of the Table type). You can also create components which are not included in the standard set (for example a StoredProc).

 

Let's look at the base classes in detail.

让我们看一下基本类的细节。

TfrxDialogComponent” is the base class for all non-visual components that can be placed on a FastReport design dialogue form. It has no any important properties or methods defined within it.

TfrxCustomDatabase” class is the base class for DB components of “Database” type.

TfrxCustomDatabase = class(TfrxDialogComponent)

protected

procedure SetConnected(Value: Boolean); virtual;

procedure SetDatabaseName(const Value: String); virtual;

procedure SetLoginPrompt(Value: Boolean); virtual;

procedure SetParams(Value: TStrings); virtual;

function GetConnected: Boolean; virtual;

function GetDatabaseName: String; virtual;

function GetLoginPrompt: Boolean; virtual;

function GetParams: TStrings; virtual;

public

procedure SetLogin(const Login, Password: String); virtual;

property Connected: Boolean read GetConnected

write SetConnected default False;

property DatabaseName: String read GetDatabaseName

write SetDatabaseName;

property LoginPrompt: Boolean read GetLoginPrompt

write SetLoginPrompt default True;

property Params: TStrings read GetParams

write SetParams;

end;

The following properties are defined in this class:

- Connected    whether DB connection is active

- DatabaseName    database name

- LoginPrompt    whether to ask for login when connecting to DB

- Params    connection parameters

 

Inherit from this class to create a component of TfrxXXXDatabase type. Once created all virtual methods must be overridden and any required properties placed in the published section. Also add any properties specific for your component.

 

The “TfrxDataset”, “TfrxCustomDBDataset” and “TfrxDBDataset” classes provide data access functions. The FastReport core uses these components for navigation and referencing data fields. As such they are part of the common hierarchy and are of no interest to us.

TfrxCustomDataSet” is a base class for DB components derived from TDataSet. Components inheriting from this class are “Query”, “Table” and “StoredProc” clones. Actually this class is a wrapper for TDataSet.

TfrxCustomDataset = class(TfrxDBDataSet)

protected

procedure SetMaster(const Value: TDataSource); virtual;

procedure SetMasterFields(const Value: String); virtual;

public

property DataSet: TDataSet;

property Fields: TFields readonly;

property MasterFields: String;

property Active: Boolean;

published

property Filter: String;

property Filtered: Boolean;

property Master: TfrxDBDataSet;

end;

The following properties are defined in this class:

- DataSet    a link to the enclosed object of “TdataSet” type

- Fields    a link to DataSet.Fields

- Active    whether the DataSet is active

- Filter    expression for filtering

- Filtered    whether filtering is active

- Master    a link to the master dataset in a master-detail relationship

- MasterFields    list of fields like 'field1=field2'; used for master-detail relationships

 

TfrxCustomTable” is the base class for DB components of Table type. This class is a wrapper for the TTable class.

TfrxCustomTable = class(TfrxCustomDataset)

protected

function GetIndexFieldNames: String; virtual;

function GetIndexName: String; virtual;

function GetTableName: String; virtual;

procedure SetIndexFieldNames(const Value: String); virtual;

procedure SetIndexName(const Value: String); virtual;

procedure SetTableName(const Value: String); virtual;

published

property MasterFields;

property TableName: String read GetTableName write SetTableName;

property IndexName: String read GetIndexName write SetIndexName;

property IndexFieldNames: String read GetIndexFieldNames

write SetIndexFieldNames;

end;

The following properties are defined in the class:

- TableName    table name

- IndexName    index name

- IndexFieldNames    index field names

Components of Table type inherit from this class. When creating a descendant of this class you should add some missing properties like Database. Also, the virtual methods of the TfrxCustomDataset and TfrxCustomTable classes must be overridden.

 

TfrxCustomQuery” is the base class for DB components of “Query” type. This class is a wrapper for the TQuery class.

TfrxCustomQuery = class(TfrxCustomDataset)

protected

procedure SetSQL(Value: TStrings); virtual; abstract;

function GetSQL: TStrings; virtual; abstract;

public

procedure UpdateParams; virtual; abstract;

published

property Params: TfrxParams;

property SQL: TStrings;

end;

The “SQL” and “Params” properties (found in all Query components) are declared in this class. Since Query components can implement parameters in different ways, for example as TParams or TParameters, the “Params” property is of “TfrxParams” type, which is a wrapper for all parameter types.

The following methods are declared in this class:

- SetSQL    sets “SQL” property of “Query” type

- GetSQL   gets “SQL” property of “Query” type

- UpdateParams    copies parameter values into component of Query type; if the Query component parameters are of TParams type then copying is by means of the frxParamsToTParams standard procedure

 

//用IBX引擎举例

Let's demonstrate the creation of a DB engine using an IBX example. The full text for the engine can be found in the SOURCE\IBX folder. Below are some extracts from the source text, with added comments.

The IBX components around which we will build the wrapper are TIBDatabase, TIBTable and TIBQuery. Our corresponding components will be named “TfrxIBXDatabase”, “TfrxIBXTable” and “TfrxIBXQuery”.

“TfrxIBXComponents” is another component that we should create; it will be placed on the FastReport component palette when registering the engine in the Delphi environment. As soon as this component is used in a project Delphi will automatically add a link to our engine unit in the “Uses” list. There is one more task to complete for this component, to define the “DefaultDatabase” property, which references an existing connection to a DB. By default all TfrxIBXTable and TfrxIBXQuery components will use this connection. The TfrxIBXComponents component must inherit from from the TfrxDBComponents class:

TfrxDBComponents = class(TComponent)

public

function GetDescription: String; virtual; abstract;

end;

A description should be returned by one function only, for example ”IBX Components”. A “TfrxIBXComponents” component is declared as follows:

type

TfrxIBXComponents = class(TfrxDBComponents)

private

FDefaultDatabase: TIBDatabase;

FOldComponents: TfrxIBXComponents;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

function GetDescription: String; override;

published

property DefaultDatabase: TIBDatabase read FDefaultDatabase

write FDefaultDatabase;

end;

var

IBXComponents: TfrxIBXComponents;

constructor TfrxIBXComponents.Create(AOwner: TComponent);

begin

inherited;

FOldComponents := IBXComponents;

IBXComponents := Self;

end;

destructor TfrxIBXComponents.Destroy;

begin

if IBXComponents = Self then

IBXComponents := FOldComponents;

inherited;

end;

function TfrxIBXComponents.GetDescription: String;

begin

Result := 'IBX';

end;

We declare an IBXComponents global variable which will reference a copy of the TfrxIBXComponents component. If you put the component into the project several times (which is pointless) you will nevertheless be able to save a link to the previous component and restore it after deleting the component.

A link to a DB connection that already exists in the project can be set in the “DefaultDatabase” property. The way we will write the TfrxIBXTable and TfrxIBXQuery components will allow them to use this connection by default (actually, this is the purpose of the IBXComponents global variable).

Here is the TfrxIBXDatabase component. It is a wrapper for the TIBDatabase class.

TfrxIBXDatabase = class(TfrxCustomDatabase)

private

FDatabase: TIBDatabase;

FTransaction: TIBTransaction;

function GetSQLDialect: Integer;

procedure SetSQLDialect(const Value: Integer);

protected

procedure SetConnected(Value: Boolean); override;

procedure SetDatabaseName(const Value: String); override;

procedure SetLoginPrompt(Value: Boolean); override;

procedure SetParams(Value: TStrings); override;

function GetConnected: Boolean; override;

function GetDatabaseName: String; override;

function GetLoginPrompt: Boolean; override;

function GetParams: TStrings; override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

class function GetDescription: String; override;

procedure SetLogin(const Login, Password: String); override;

property Database: TIBDatabase read FDatabase;

published

{ list TIBDatabase properties.Note – some properties already exist in base class }

property DatabaseName;

property LoginPrompt;

property Params;

property SQLDialect: Integer read GetSQLDialect write SetSQLDialect;

{ Connected property should be placed last! }

property Connected;

end;

constructor TfrxIBXDatabase.Create(AOwner: TComponent);

begin

inherited;

{ create component – connection }

FDatabase := TIBDatabase.Create(nil);

{ create component - transaction (specific to IBX) }

FTransaction := TIBTransaction.Create(nil);

FDatabase.DefaultTransaction := FTransaction;

{ don't forget this line! }

Component := FDatabase;

end;

destructor TfrxIBXDatabase.Destroy;

begin

{ delete transaction }

FTransaction.Free;

{ connection will be deleted automatically in parent class }

inherited;

end;

{ component description will be displayed next to icon

in objects toolbar }

class function TfrxIBXDatabase.GetDescription: String;

begin

Result := 'IBX Database';

end;

{ redirect component properties to cover properties and vice versa }

function TfrxIBXDatabase.GetConnected: Boolean;

begin

Result := FDatabase.Connected;

end;

function TfrxIBXDatabase.GetDatabaseName: String;

begin

Result := FDatabase.DatabaseName;

end;

function TfrxIBXDatabase.GetLoginPrompt: Boolean;

begin

Result := FDatabase.LoginPrompt;

end;

function TfrxIBXDatabase.GetParams: TStrings;

begin

Result := FDatabase.Params;

end;

function TfrxIBXDatabase.GetSQLDialect: Integer;

begin

Result := FDatabase.SQLDialect;

end;

procedure TfrxIBXDatabase.SetConnected(Value: Boolean);

begin

FDatabase.Connected := Value;

FTransaction.Active := Value;

end;

procedure TfrxIBXDatabase.SetDatabaseName(const Value: String);

begin

FDatabase.DatabaseName := Value;

end;

procedure TfrxIBXDatabase.SetLoginPrompt(Value: Boolean);

begin

FDatabase.LoginPrompt := Value;

end;

procedure TfrxIBXDatabase.SetParams(Value: TStrings);

begin

FDatabase.Params := Value;

end;

procedure TfrxIBXDatabase.SetSQLDialect(const Value: Integer);

begin

FDatabase.SQLDialect := Value;

end;

{ this method is used by DB connection wizard }

procedure TfrxIBXDatabase.SetLogin(const Login, Password: String);

begin

Params.Text := 'user_name=' + Login + #13#10 + 'password=' + Password;

end;

As you can see, this is not that complicated. We created FDatabase : “TIBDatabase” object and then defined the properties we want the designer to show. “Get” and “Set” methods were written for each property.

The next class is “TfrxIBXTable”. As mentioned above, it inherits from the TfrxCustomDataSet standard class. All the basic functionality (operating with a list of fields, master-detail and basic properties) is already implemented in the base class. We only need to declare properties that are specific to this component.

TfrxIBXTable = class(TfrxCustomTable)

private

FDatabase: TfrxIBXDatabase;

FTable: TIBTable;

procedure SetDatabase(const Value: TfrxIBXDatabase);

protected

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

procedure SetMaster(const Value: TDataSource); override;

procedure SetMasterFields(const Value: String); override;

procedure SetIndexFieldNames(const Value: String); override;

procedure SetIndexName(const Value: String); override;

procedure SetTableName(const Value: String); override;

function GetIndexFieldNames: String; override;

function GetIndexName: String; override;

function GetTableName: String; override;

public

constructor Create(AOwner: TComponent); override;

constructor DesignCreate(AOwner: TComponent; Flags: Word); override;

class function GetDescription: String; override;

procedure BeforeStartReport; override;

property Table: TIBTable read FTable;

published

property Database: TfrxIBXDatabase read FDatabase write SetDatabase;

end;

constructor TfrxIBXTable.Create(AOwner: TComponent);

begin

{ create component – table }

FTable := TIBTable.Create(nil);

{ assign link to DataSet property from basic class

– don't forget this string! }

DataSet := FTable;

{ assign link to connection to DB by default }

SetDatabase(nil);

{ after that basic constructor may be called in}

inherited;

end;

{ this constructor is called at the moment of adding components to report;

it connects table to TfrxIBXDatabase component automatically,

if it is already present }

constructor TfrxIBXTable.DesignCreate(AOwner: TComponent; Flags: Word);

var

i: Integer;

l: TList;

begin

inherited;

l := Report.AllObjects;

for i := 0 to l.Count - 1 do

if TObject(l[i]) is TfrxIBXDatabase then

begin

SetDatabase(TfrxIBXDatabase(l[i]));

break;

end;

end;

class function TfrxIBXTable.GetDescription: String;

begin

Result := 'IBX Table';

end;

{ trace TfrxIBXDatabase component deletion; we address this component in FDatabase property; otherwise can generate an error }

procedure TfrxIBXTable.Notification(AComponent: TComponent; Operation: TOperation);

begin

inherited;

if (Operation = opRemove) and (AComponent = FDatabase) then

SetDatabase(nil);

end;

procedure TfrxIBXTable.SetDatabase(const Value: TfrxIBXDatabase);

begin

{ Database property of TfrxIBXDatabase type, not of TIBDatabase type! }

FDatabase := Value;

{ if value <> nil, connect table to selected component }

if Value <> nil then

FTable.Database := Value.Database

{ otherwise try to connect to DB by default,

defined in TfrxIBXComponents component }

else if IBXComponents <> nil then

FTable.Database := IBXComponents.DefaultDatabase

{ if there were no TfrxIBXComponents for some reason, reset to nil }

else

FTable.Database := nil;

{ if connection was successful DBConnected flag should be put }

DBConnected := FTable.Database <> nil;

end;

function TfrxIBXTable.GetIndexFieldNames: String;

begin

Result := FTable.IndexFieldNames;

end;

function TfrxIBXTable.GetIndexName: String;

begin

Result := FTable.IndexName;

end;

function TfrxIBXTable.GetTableName: String;

begin

Result := FTable.TableName;

end;

procedure TfrxIBXTable.SetIndexFieldNames(const Value: String);

begin

FTable.IndexFieldNames := Value;

end;

procedure TfrxIBXTable.SetIndexName(const Value: String);

begin

FTable.IndexName := Value;

end;

procedure TfrxIBXTable.SetTableName(const Value: String);

begin

FTable.TableName := Value;

end;

procedure TfrxIBXTable.SetMaster(const Value: TDataSource);

begin

FTable.MasterSource := Value;

end;

procedure TfrxIBXTable.SetMasterFields(const Value: String);

begin

FTable.MasterFields := Value;

FTable.IndexFieldNames := Value;

end;

{ we need to implement this method in some cases }

procedure TfrxIBXTable.BeforeStartReport;

begin

SetDatabase(FDatabase);

end;

Finally, let’s look at the last component, “TfrxIBXQuery”. It inherits from the TfrxCustomQuery base class, in which the required properties are already declared. We only need to declare the Database property and override the SetMaster method. The implementation of the other methods is similar to the TfrxIBXTable component.

TfrxIBXQuery = class(TfrxCustomQuery)

private

FDatabase: TfrxIBXDatabase;

FQuery: TIBQuery;

procedure SetDatabase(const Value: TfrxIBXDatabase);

protected

procedure Notification(AComponent: TComponent; Operation: TOperation); override;

procedure SetMaster(const Value: TDataSource); override;

procedure SetSQL(Value: TStrings); override;

function GetSQL: TStrings; override;

public

constructor Create(AOwner: TComponent); override;

constructor DesignCreate(AOwner: TComponent; Flags: Word); override;

class function GetDescription: String; override;

procedure BeforeStartReport; override;

procedure UpdateParams; override;

property Query: TIBQuery read FQuery;

published

property Database: TfrxIBXDatabase read FDatabase write SetDatabase;

end;

constructor TfrxIBXQuery.Create(AOwner: TComponent);

begin

{ create component – query }

FQuery := TIBQuery.Create(nil);

{ assign link to it to DataSet property from base class

– don't forget this line! }

Dataset := FQuery;

{ assign link to connection to DB by default }

SetDatabase(nil);

{ after that base constructor may be called }

inherited;

end;

constructor TfrxIBXQuery.DesignCreate(AOwner: TComponent; Flags: Word);

var

i: Integer;

l: TList;

begin

inherited;

l := Report.AllObjects;

for i := 0 to l.Count - 1 do

if TObject(l[i]) is TfrxIBXDatabase then

begin

SetDatabase(TfrxIBXDatabase(l[i]));

break;

end;

end;

class function TfrxIBXQuery.GetDescription: String;

begin

Result := 'IBX Query';

end;

procedure TfrxIBXQuery.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited;

if (Operation = opRemove) and (AComponent = FDatabase) then

SetDatabase(nil);

end;

procedure TfrxIBXQuery.SetDatabase(const Value: TfrxIBXDatabase);

begin

FDatabase := Value;

if Value <> nil then

FQuery.Database := Value.Database

else if IBXComponents <> nil then

FQuery.Database := IBXComponents.DefaultDatabase

else

FQuery.Database := nil;

DBConnected := FQuery.Database <> nil;

end;

procedure TfrxIBXQuery.SetMaster(const Value: TDataSource);

begin

FQuery.DataSource := Value;

end;

function TfrxIBXQuery.GetSQL: TStrings;

begin

Result := FQuery.SQL;

end;

procedure TfrxIBXQuery.SetSQL(Value: TStrings);

begin

FQuery.SQL := Value;

end;

procedure TfrxIBXQuery.UpdateParams;

begin

{ in this method it is sufficient to assign values

from Params to FQuery.Params }

{ this is performed via standard procedure }

frxParamsToTParams(Self, FQuery.Params);

end;

procedure TfrxIBXQuery.BeforeStartReport;

begin

SetDatabase(FDatabase);

end;

 

//注册组件

Registration of all engine components is performed in the “Initialization” section.

initialization

{ use standard pictures indexes 37,38,39 instead of pictures}

frxObjects.RegisterObject1(TfrxIBXDataBase, nil, '', '', 0, 37);

frxObjects.RegisterObject1(TfrxIBXTable, nil, '', '', 0, 38);

frxObjects.RegisterObject1(TfrxIBXQuery, nil, '', '', 0, 39);

finalization

frxObjects.Unregister(TfrxIBXDataBase);

frxObjects.Unregister(TfrxIBXTable);

frxObjects.Unregister(TfrxIBXQuery);

end.

//脚本中使用注册

This is enough to use the engine in reports. There are two more things left at this stage: to register the engine classes in the script system so that they can be referred to in the script, and to register several property editors (for example TfrxIBXTable.TableName) to make working with the component easier.

It is better to store the engine registration code in a separate file with a RTTI suffix. See more about class registration in the script system in the appropriate chapter. Here is an example of a file:

unit frxIBXRTTI;

interface

{$I frx.inc}

implementation

uses

Windows, Classes, fs_iinterpreter, frxIBXComponents

{$IFDEF Delphi6}

, Variants

{$ENDIF};

type

TFunctions = class(TfsRTTIModule)

public

constructor Create(AScript: TfsScript); override;

end;

{ TFunctions }

constructor TFunctions.Create;

begin

inherited Create(AScript);

with AScript do

begin

AddClass(TfrxIBXDatabase, 'TfrxComponent');

AddClass(TfrxIBXTable, 'TfrxCustomDataset');

AddClass(TfrxIBXQuery, 'TfrxCustomQuery');

end;

end;

initialization

fsRTTIModules.Add(TFunctions);

end.

//编辑器

It is also recommended that property editor code is put in a separate file with an 'Editor' suffix. In our case, editors for the TfrxIBXDatabase.DatabaseName, TfrxIBXTable.IndexName and TfrxIBXTable.TableName properties were required. See more about writing property editors in the appropriate chapter. Below is an example of a file:

unit frxIBXEditor;

interface

{$I frx.inc}

implementation

uses

Windows, Classes, SysUtils, Forms, Dialogs, frxIBXComponents, frxCustomDB,

frxDsgnIntf, frxRes, IBDatabase, IBTable

{$IFDEF Delphi6}

, Variants

{$ENDIF};

type

TfrxDatabaseNameProperty = class(TfrxStringProperty)

public

function GetAttributes: TfrxPropertyAttributes; override;

function Edit: Boolean; override;

end;

TfrxTableNameProperty = class(TfrxStringProperty)

public

function GetAttributes: TfrxPropertyAttributes; override;

procedure GetValues; override;

end;

TfrxIndexNameProperty = class(TfrxStringProperty)

public

function GetAttributes: TfrxPropertyAttributes; override;

procedure GetValues; override;

end;

{ TfrxDatabaseNameProperty }

function TfrxDatabaseNameProperty.GetAttributes: TfrxPropertyAttributes;

begin

{ this property possesses an editor }

Result := [paDialog];

end;

function TfrxDatabaseNameProperty.Edit: Boolean;

var

SaveConnected: Bool;

db: TIBDatabase;

begin

{ get link to TfrxIBXDatabase.Database }

db := TfrxIBXDatabase(Component).Database;

{ create standard OpenDialog }

with TOpenDialog.Create(nil) do

begin

InitialDir := GetCurrentDir;

{ we are interested in *.gdb files }

Filter := frxResources.Get('ftDB') + ' (*.gdb)|*.gdb|'

+ frxResources.Get('ftAllFiles') + ' (*.*)|*.*';

Result := Execute;

if Result then

begin

SaveConnected := db.Connected;

db.Connected := False;

{ if dialogue is completed successfully, assign new DB name }

db.DatabaseName := FileName;

db.Connected := SaveConnected;

end;

Free;

end;

end;

{ TfrxTableNameProperty }

function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;

begin

{ property represents list of values }

Result := [paMultiSelect, paValueList];

end;

procedure TfrxTableNameProperty.GetValues;

var

t: TIBTable;

begin

inherited;

{ get link to TIBTable component }

t := TfrxIBXTable(Component).Table;

{ fill list of tables available }

if t.Database <> nil then

t.DataBase.GetTableNames(Values, False);

end;

{ TfrxIndexProperty }

function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;

begin

{ property represents list of values }

Result := [paMultiSelect, paValueList];

end;

procedure TfrxIndexNameProperty.GetValues;

var

i: Integer;

begin

inherited;

try

{ get link to TIBTable component }

with TfrxIBXTable(Component).Table do

if (TableName <> '') and (IndexDefs <> nil) then

begin

{ update indexes }

IndexDefs.Update;

{ fill list of indexes available }

for i := 0 to IndexDefs.Count - 1 do

if IndexDefs[i].Name <> '' then

Values.Add(IndexDefs[i].Name);

end;

except

end;

end;

initialization

frxPropertyEditors.Register(TypeInfo(String), TfrxIBXDataBase,

'DatabaseName', TfrxDataBaseNameProperty);

frxPropertyEditors.Register(TypeInfo(String), TfrxIBXTable,

'TableName', TfrxTableNameProperty);

frxPropertyEditors.Register(TypeInfo(String), TfrxIBXTable,

'IndexName', TfrxIndexNameProperty);

end.

posted @ 2016-05-26 16:18  翼想天开的男孩  阅读(379)  评论(0编辑  收藏  举报