527 lines
13 KiB
ObjectPascal
527 lines
13 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ BDE enduser components }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxBDEComponents;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
Windows, Classes, SysUtils, frxClass, frxCustomDB, DB, DBTables, Variants
|
|
{$IFDEF QBUILDER}
|
|
, fqbClass
|
|
{$ENDIF};
|
|
|
|
|
|
type
|
|
{$IFDEF DELPHI16}
|
|
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
|
|
{$ENDIF}
|
|
/// <summary>
|
|
/// The TfrxBDEComponents component allows the use of internal BDE data
|
|
/// objects in your report.
|
|
/// </summary>
|
|
TfrxBDEComponents = class(TfrxDBComponents)
|
|
private
|
|
FDefaultDatabase: String;
|
|
FDefaultSession: String;
|
|
FOldComponents: TfrxBDEComponents;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function GetDescription: String; override;
|
|
published
|
|
/// <summary>
|
|
/// Link to the default database connection that will be used in the
|
|
/// report.
|
|
/// </summary>
|
|
property DefaultDatabase: String read FDefaultDatabase write FDefaultDatabase;
|
|
/// <summary>
|
|
/// Link to the default session that will be used in the report.
|
|
/// </summary>
|
|
property DefaultSession: String read FDefaultSession write FDefaultSession;
|
|
end;
|
|
|
|
/// <summary>
|
|
/// The TfrxBDEDatabase component represents a database connection.
|
|
/// </summary>
|
|
TfrxBDEDatabase = class(TfrxCustomDatabase)
|
|
private
|
|
FDatabase: TDatabase;
|
|
procedure SetAliasName(const Value: String);
|
|
procedure SetDriverName(const Value: String);
|
|
function GetAliasName: String;
|
|
function GetDriverName: String;
|
|
protected
|
|
function GetConnected: Boolean; override;
|
|
function GetDatabaseName: String; override;
|
|
function GetLoginPrompt: Boolean; override;
|
|
function GetParams: TStrings; override;
|
|
procedure SetConnected(Value: Boolean); override;
|
|
procedure SetDatabaseName(const Value: String); override;
|
|
procedure SetLoginPrompt(Value: Boolean); override;
|
|
procedure SetParams(Value: TStrings); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
class function GetDescription: String; override;
|
|
/// <summary>
|
|
/// Reference to internal TDatabase object.
|
|
/// </summary>
|
|
property Database: TDatabase read FDatabase;
|
|
published
|
|
/// <summary>
|
|
/// Name of the BDE alias.
|
|
/// </summary>
|
|
property AliasName: String read GetAliasName write SetAliasName;
|
|
property DatabaseName;
|
|
/// <summary>
|
|
/// Name of the BDE driver.
|
|
/// </summary>
|
|
property DriverName: String read GetDriverName write SetDriverName;
|
|
property LoginPrompt;
|
|
property Params;
|
|
property Connected;
|
|
end;
|
|
|
|
/// <summary>
|
|
/// The TfrxBDETable represents a table.
|
|
/// </summary>
|
|
TfrxBDETable = class(TfrxCustomTable)
|
|
private
|
|
FTable: TTable;
|
|
procedure SetDatabaseName(const Value: String);
|
|
function GetDatabaseName: String;
|
|
procedure SetSessionName(const Value: String);
|
|
function GetSessionName: String;
|
|
protected
|
|
procedure SetMaster(const Value: TDataSource); override;
|
|
procedure SetMasterFields(const Value: String); override;
|
|
procedure SetIndexName(const Value: String); override;
|
|
procedure SetIndexFieldNames(const Value: String); override;
|
|
procedure SetTableName(const Value: String); override;
|
|
function GetIndexName: String; override;
|
|
function GetIndexFieldNames: String; override;
|
|
function GetTableName: String; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
class function GetDescription: String; override;
|
|
/// <summary>
|
|
/// Reference to internal TTable object.
|
|
/// </summary>
|
|
property Table: TTable read FTable;
|
|
published
|
|
/// <summary>
|
|
/// Name of the database connection. If this property is empty,
|
|
/// TfrxBDEComponents.DefaultDatabase is used.
|
|
/// </summary>
|
|
property DatabaseName: String read GetDatabaseName write SetDatabaseName;
|
|
/// <summary>
|
|
/// Name of the session. If this property is empty,
|
|
/// TfrxBDEComponents.DefaultSession is used.
|
|
/// </summary>
|
|
property SessionName: String read GetSessionName write SetSessionName;
|
|
end;
|
|
|
|
/// <summary>
|
|
/// The TfrxBDEQuery component represents a query.
|
|
/// </summary>
|
|
TfrxBDEQuery = class(TfrxCustomQuery)
|
|
private
|
|
FQuery: TQuery;
|
|
procedure SetDatabaseName(const Value: String);
|
|
function GetDatabaseName: String;
|
|
procedure SetSessionName(const Value: String);
|
|
function GetSessionName: String;
|
|
protected
|
|
procedure SetMaster(const Value: TDataSource); override;
|
|
procedure SetSQL(Value: TStrings); override;
|
|
function GetSQL: TStrings; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
class function GetDescription: String; override;
|
|
procedure UpdateParams; override;
|
|
{$IFDEF QBUILDER}
|
|
function QBEngine: TfqbEngine; override;
|
|
{$ENDIF}
|
|
/// <summary>
|
|
/// Reference to internal TQuery object.
|
|
/// </summary>
|
|
property Query: TQuery read FQuery;
|
|
published
|
|
/// <summary>
|
|
/// Name of the database connection. If this property is empty,
|
|
/// TfrxBDEComponents.DefaultDatabase is used.
|
|
/// </summary>
|
|
property DatabaseName: String read GetDatabaseName write SetDatabaseName;
|
|
/// <summary>
|
|
/// Name of the session. If this property is empty,
|
|
/// TfrxBDEComponents.DefaultSession is used.
|
|
/// </summary>
|
|
property SessionName: String read GetSessionName write SetSessionName;
|
|
end;
|
|
|
|
{$IFDEF QBUILDER}
|
|
TfrxEngineBDE = class(TfqbEngine)
|
|
private
|
|
FQuery: TQuery;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ReadTableList(ATableList: TStrings); override;
|
|
procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
|
|
function ResultDataSet: TDataSet; override;
|
|
procedure SetSQL(const Value: string); override;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
var
|
|
BDEComponents: TfrxBDEComponents;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxBDERTTI,
|
|
{$IFNDEF NO_EDITORS}
|
|
frxBDEEditor,
|
|
{$ENDIF}
|
|
frxDsgnIntf, frxRes;
|
|
|
|
|
|
{ TfrxDBComponents }
|
|
|
|
constructor TfrxBDEComponents.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FDefaultSession := 'Default';
|
|
FOldComponents := BDEComponents;
|
|
BDEComponents := Self;
|
|
end;
|
|
|
|
destructor TfrxBDEComponents.Destroy;
|
|
begin
|
|
if BDEComponents = Self then
|
|
BDEComponents := FOldComponents;
|
|
inherited;
|
|
end;
|
|
|
|
function TfrxBDEComponents.GetDescription: String;
|
|
begin
|
|
Result := 'BDE';
|
|
end;
|
|
|
|
|
|
{ TfrxBDEDatabase }
|
|
|
|
constructor TfrxBDEDatabase.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FDatabase := TDatabase.Create(nil);
|
|
Component := FDatabase;
|
|
end;
|
|
|
|
class function TfrxBDEDatabase.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('obBDEDB');
|
|
end;
|
|
|
|
function TfrxBDEDatabase.GetAliasName: String;
|
|
begin
|
|
Result := FDatabase.AliasName;
|
|
end;
|
|
|
|
function TfrxBDEDatabase.GetConnected: Boolean;
|
|
begin
|
|
Result := FDatabase.Connected;
|
|
end;
|
|
|
|
function TfrxBDEDatabase.GetDatabaseName: String;
|
|
begin
|
|
Result := FDatabase.DatabaseName;
|
|
end;
|
|
|
|
function TfrxBDEDatabase.GetDriverName: String;
|
|
begin
|
|
Result := FDatabase.DriverName;
|
|
end;
|
|
|
|
function TfrxBDEDatabase.GetLoginPrompt: Boolean;
|
|
begin
|
|
Result := FDatabase.LoginPrompt;
|
|
end;
|
|
|
|
function TfrxBDEDatabase.GetParams: TStrings;
|
|
begin
|
|
Result := FDatabase.Params;
|
|
end;
|
|
|
|
procedure TfrxBDEDatabase.SetAliasName(const Value: String);
|
|
begin
|
|
FDatabase.AliasName := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEDatabase.SetConnected(Value: Boolean);
|
|
begin
|
|
BeforeConnect(Value);
|
|
FDatabase.Connected := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEDatabase.SetDatabaseName(const Value: String);
|
|
begin
|
|
FDatabase.DatabaseName := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEDatabase.SetDriverName(const Value: String);
|
|
begin
|
|
FDatabase.DriverName := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEDatabase.SetLoginPrompt(Value: Boolean);
|
|
begin
|
|
FDatabase.LoginPrompt := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEDatabase.SetParams(Value: TStrings);
|
|
begin
|
|
FDatabase.Params := Value;
|
|
end;
|
|
|
|
|
|
{ TfrxBDETable }
|
|
|
|
constructor TfrxBDETable.Create(AOwner: TComponent);
|
|
begin
|
|
FTable := TTable.Create(nil);
|
|
DataSet := FTable;
|
|
if BDEComponents <> nil then
|
|
begin
|
|
DatabaseName := BDEComponents.DefaultDatabase;
|
|
SessionName := BDEComponents.DefaultSession;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
class function TfrxBDETable.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('obBDETb');
|
|
end;
|
|
|
|
function TfrxBDETable.GetDatabaseName: String;
|
|
begin
|
|
Result := FTable.DatabaseName;
|
|
end;
|
|
|
|
function TfrxBDETable.GetSessionName: String;
|
|
begin
|
|
Result := FTable.SessionName;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetDatabaseName(const Value: String);
|
|
begin
|
|
FTable.DatabaseName := Value;
|
|
DBConnected := True;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetSessionName(const Value: String);
|
|
begin
|
|
FTable.SessionName := Value;
|
|
end;
|
|
|
|
function TfrxBDETable.GetIndexName: String;
|
|
begin
|
|
Result := FTable.IndexName;
|
|
end;
|
|
|
|
function TfrxBDETable.GetIndexFieldNames: String;
|
|
begin
|
|
Result := FTable.IndexFieldNames;
|
|
end;
|
|
|
|
function TfrxBDETable.GetTableName: String;
|
|
begin
|
|
Result := FTable.TableName;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetIndexName(const Value: String);
|
|
begin
|
|
FTable.IndexName := Value;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetIndexFieldNames(const Value: String);
|
|
begin
|
|
FTable.IndexFieldNames := Value;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetTableName(const Value: String);
|
|
begin
|
|
FTable.TableName := Value;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetMaster(const Value: TDataSource);
|
|
begin
|
|
FTable.MasterSource := Value;
|
|
end;
|
|
|
|
procedure TfrxBDETable.SetMasterFields(const Value: String);
|
|
begin
|
|
FTable.MasterFields := Value;
|
|
end;
|
|
|
|
|
|
{ TfrxBDEQuery }
|
|
|
|
constructor TfrxBDEQuery.Create(AOwner: TComponent);
|
|
begin
|
|
FQuery := TQuery.Create(nil);
|
|
Dataset := FQuery;
|
|
if BDEComponents <> nil then
|
|
begin
|
|
DatabaseName := BDEComponents.DefaultDatabase;
|
|
SessionName := BDEComponents.DefaultSession;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
class function TfrxBDEQuery.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('obBDEQ');
|
|
end;
|
|
|
|
function TfrxBDEQuery.GetDatabaseName: String;
|
|
begin
|
|
Result := FQuery.DatabaseName;
|
|
end;
|
|
|
|
function TfrxBDEQuery.GetSessionName: String;
|
|
begin
|
|
Result := FQuery.SessionName;
|
|
end;
|
|
|
|
function TfrxBDEQuery.GetSQL: TStrings;
|
|
begin
|
|
Result := FQuery.SQL;
|
|
end;
|
|
|
|
procedure TfrxBDEQuery.SetDatabaseName(const Value: String);
|
|
begin
|
|
FQuery.DatabaseName := Value;
|
|
DBConnected := True;
|
|
end;
|
|
|
|
procedure TfrxBDEQuery.SetMaster(const Value: TDataSource);
|
|
begin
|
|
FQuery.DataSource := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEQuery.SetSessionName(const Value: String);
|
|
begin
|
|
FQuery.SessionName := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEQuery.SetSQL(Value: TStrings);
|
|
begin
|
|
FQuery.SQL := Value;
|
|
end;
|
|
|
|
procedure TfrxBDEQuery.UpdateParams;
|
|
begin
|
|
frxParamsToTParams(Self, FQuery.Params);
|
|
end;
|
|
|
|
{$IFDEF QBUILDER}
|
|
function TfrxBDEQuery.QBEngine: TfqbEngine;
|
|
begin
|
|
Result := TfrxEngineBDE.Create(nil);
|
|
TfrxEngineBDE(Result).FQuery.DatabaseName := FQuery.DatabaseName;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
{$IFDEF QBUILDER}
|
|
constructor TfrxEngineBDE.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FQuery := TQuery.Create(Self);
|
|
end;
|
|
|
|
destructor TfrxEngineBDE.Destroy;
|
|
begin
|
|
FQuery.Free;
|
|
inherited
|
|
end;
|
|
|
|
procedure TfrxEngineBDE.ReadFieldList(const ATableName: string;
|
|
var AFieldList: TfqbFieldList);
|
|
var
|
|
TempTable: TTable;
|
|
Fields: TFieldDefs;
|
|
i: Integer;
|
|
tmpField: TfqbField;
|
|
begin
|
|
AFieldList.Clear;
|
|
TempTable := TTable.Create(Self);
|
|
TempTable.DatabaseName := FQuery.DatabaseName;
|
|
TempTable.TableName := ATableName;
|
|
Fields := TempTable.FieldDefs;
|
|
try
|
|
try
|
|
TempTable.Active := True;
|
|
tmpField:= TfqbField(AFieldList.Add);
|
|
tmpField.FieldName := '*';
|
|
for i := 0 to Fields.Count - 1 do
|
|
begin
|
|
tmpField := TfqbField(AFieldList.Add);
|
|
tmpField.FieldName := Fields.Items[i].Name;
|
|
tmpField.FieldType := Ord(Fields.Items[i].DataType)
|
|
end;
|
|
except
|
|
end;
|
|
finally
|
|
TempTable.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxEngineBDE.ReadTableList(ATableList: TStrings);
|
|
begin
|
|
ATableList.BeginUpdate;
|
|
ATableList.Clear;
|
|
try
|
|
Session.GetTableNames(FQuery.DatabaseName, '', True, ShowSystemTables, ATableList);
|
|
finally
|
|
ATableList.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TfrxEngineBDE.ResultDataSet: TDataSet;
|
|
begin
|
|
Result := FQuery;
|
|
end;
|
|
|
|
procedure TfrxEngineBDE.SetSQL(const Value: string);
|
|
begin
|
|
FQuery.SQL.Text := Value;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
frxObjects.RegisterObject1(TfrxBDEDataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 54);
|
|
frxObjects.RegisterObject1(TfrxBDETable, nil, '', {$IFDEF DB_CAT}'TABLES'{$ELSE}''{$ENDIF}, 0, 55);
|
|
frxObjects.RegisterObject1(TfrxBDEQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 56);
|
|
|
|
finalization
|
|
frxObjects.UnRegister(TfrxBDEDataBase);
|
|
frxObjects.UnRegister(TfrxBDETable);
|
|
frxObjects.UnRegister(TfrxBDEQuery);
|
|
|
|
|
|
end.
|