daabsolutedb.pas

This is End User Control Program

unit daAbsoluteDB;

interface

{$I ppIfDef.pas}

uses Classes, SysUtils, Forms, ExtCtrls,  DB,
     ppClass, ppComm, ppDBPipe, ppDB, ppClasUt, ppTypes, // ppUtils,
     daDB, daQueryDataView, daDataView, daPreviewDataDlg,
     ABSMain;

type

  {Absolute Database DataView Classes:

     1.  ABS TDataSet descendants
           - TDataSets that can be children of a DataView.
           - Override the HasParent method of TComponent to return True
           - Must be registerd with the Delphi IDE using the RegisterNoIcon procedure

       a. TdaChildABSDataSet - TSimpleDataSet descendant that can be a child of a DataView

     3.  TdaABSSession
           - descendant of TppSession
           - implements GetDatabaseNames, GetTableNames, etc.

     4.  TdaABSDataSet
          - descendant of TppDataSet
          - implements GetFieldNames for SQL

     5.  TdaABSQueryDataView
          - descendant of TppQueryDataView
          - uses the above classes to create the required
            DataSet -> DataSource -> Pipeline -> Report connection
          - uses the TdaSQL object built by the QueryWizard to assign
            SQL to the TdaSQLDataSet etc.
      }


  {@TdaChildABSQuery
    Used by a dataview to create a ABS query without a non-visual component
    appearing on the Delphi form or data module (see RegisterNoIcon call at
    bottom of this unit.)}

  TdaChildABSQuery = class(TABSQuery)
    public
      function HasParent: Boolean; override;
    end;  {class, TdaChildABSQuery}


  {@TdaChildABSTable
    Used by a dataview to create a ABS table without a non-visual component
    appearing on the Delphi form or data module (see RegisterNoIcon call at
    bottom of this unit.)}

  TdaChildABSTable = class(TABSTable)
    public
      function HasParent: Boolean; override;
    end;  {class, TdaChildABSTable}


  { TdaABSSession }
  TdaABSSession = class(TdaSession)
    private
    protected
      function GetDefaultDatabase(const aDatabaseName: String): TComponent; override;
      function IsNamedDatabase(const aDatabaseName: String; aDatabase: TComponent): Boolean; override;
    public
      class function ClassDescription: String; override;
      class function DataSetClass: TdaDataSetClass; override;
      class function DatabaseClass: TComponentClass; override;
      class function GetDefaultABSDatabase: TABSDatabase;

      function  DefaultSQLType(aDatabaseType: TppDatabaseType): TppSQLType; override;
      procedure GetDatabaseNames(aList: TStrings); override;
      function  GetDatabaseType(const aDatabaseName: String): TppDatabaseType; override;
      procedure GetTableNames(const aDatabaseName: String; aList: TStrings); override;
      function  ValidDatabaseTypes: TppDatabaseTypes; override;
  end; {class, TdaABSSession}


  {@TdaABSDataSet
    Used by DADE to submit SQL to ABS for validation purposes. When
    EditSQLAsText is True, also used to get the field names of the dataset.}
    
  TdaABSDataSet = class(TdaDataSet)
    private
      FDataSet: TABSTable;
      FDatabase: TABSDatabase;
      function GetDataSet: TDataSet;
    protected
      procedure BuildFieldList; override;
      function  GetActive: Boolean; override;
      procedure SetActive(Value: Boolean); override;
      procedure SetDatabase(aDatabase: TComponent); override;
      procedure SetDataName(const aDataName: String); override;
      property DataSet: TDataSet read GetDataSet;
    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;
      class function ClassDescription: String; override;
      procedure GetFieldNamesForSQL(aList: TStrings; aSQL: TStrings); override;
      procedure GetFieldsForSQL(aList: TList; aSQL: TStrings); override;
  end; {class, TdaABSDataSet}


  { TdaABSQueryDataView }
  TdaABSQueryDataView = class(TdaQueryDataView)
    private
      FDataSource: TppChildDataSource;
      FQuery: TABSQuery;
    protected
      procedure SQLChanged; override;
    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;
      {used to hook into DBPipeline so that ClientDataSet.ApplyUpdates can be called as needed}
      class function PreviewFormClass: TFormClass; override;
      class function SessionClass: TClass; override;
      procedure Init; override;
      procedure ConnectPipelinesToData; override;
    published
      property DataSource: TppChildDataSource read FDataSource;
  end; {class, TdaABSQueryDataView}

  {Delphi design time registration}
  procedure Register;


implementation

const
  cDefaultDatabase = 'DefaultABSConnection';

var
  FABSDatabase: TABSDatabase;


{******************************************************************************
 *
 ** C H I L D   A B S   D A T A   A C C E S S   C O M P O N E N T S
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TdaChildABSQuery.HasParent }
function TdaChildABSQuery.HasParent: Boolean;
begin
  Result := True;
end; {function, HasParent}

{------------------------------------------------------------------------------}
{ TdaChildABSTable.HasParent }
function TdaChildABSTable.HasParent: Boolean;
begin
  Result := True;
end; {function, HasParent}


{******************************************************************************
 *
 ** A B S   S E S S I O N
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TdaABSSession.ClassDescription }

class function TdaABSSession.ClassDescription: String;
begin
  Result := 'ABSSession';
end; {class function, ClassDescription}

{------------------------------------------------------------------------------}
{ TdaABSSession.DataSetClass }

class function TdaABSSession.DataSetClass: TdaDataSetClass;
begin
  Result := TdaABSDataSet;
end; {class function, DataSetClass}

{------------------------------------------------------------------------------}
{ TdaABSSession.DatabaseClass }

class function TdaABSSession.DatabaseClass: TComponentClass;
begin
  Result := TABSDatabase;
end;

{------------------------------------------------------------------------------}
{ TdaABSSession.GetDefaultABSDatabase }

class function TdaABSSession.GetDefaultABSDatabase: TABSDatabase;
begin
  {create the default ABS database, if needed}
  if (FABSDatabase = nil) then
  begin
    {create default ABS database}
    FABSDatabase := TABSDatabase.Create(nil);
    FABSDatabase.Name := cDefaultDatabase;
  end;
  Result := FABSDatabase;
end; {function, daGetDefaultABSConnection}

{------------------------------------------------------------------------------}
{ TdaABSSession.GetTableNames }

procedure TdaABSSession.GetTableNames(const aDatabaseName: String; aList: TStrings);
var  lDatabase: TABSDatabase;
begin
  lDatabase := TABSDatabase(GetDatabaseForName(aDatabaseName));  // ???

  {connection must be active to get table names}
  if not(lDatabase.Connected) then
    lDatabase.Connected := True;

  if lDatabase.Connected then
    lDatabase.GetTablesList(aList);

end; {procedure, GetTableNames}

{------------------------------------------------------------------------------}
{ TdaABSSession.GetDatabaseNames }

procedure TdaABSSession.GetDatabaseNames(aList: TStrings);
begin
  {call inherited to build list of available TABSDatabase components}
  inherited GetDatabaseNames(aList);

  {could add hard-coded connection strings here, or could
   read from an .ini file }

end; {procedure, GetDatabaseNames}

{------------------------------------------------------------------------------}
{ TdaABSSession.GetDefaultDatabase }

function TdaABSSession.GetDefaultDatabase(const aDatabaseName: String): TComponent;
var  lDatabase: TABSDatabase;
begin
  lDatabase := GetDefaultABSDatabase;

  {set DatabaseName property, if needed}
  if (lDatabase.DatabaseName <> aDatabaseName) then
    begin
      if lDatabase.Connected then
        lDatabase.Connected := False;
      lDatabase.DatabaseName := aDatabaseName;
    end;

  Result := lDatabase;

end; {function, GetDefaultDatabase}

{------------------------------------------------------------------------------}
{ TdaABSSession.IsNamedDatabase }

function TdaABSSession.IsNamedDatabase(const aDatabaseName: String; aDatabase: TComponent): Boolean;
begin
  Result := (AnsiCompareText(aDatabase.Name, aDatabaseName) = 0) or
            (AnsiCompareText(TABSDatabase(aDatabase).DatabaseName, aDatabaseName) = 0);
end; {function, IsNamedDatabase}

{------------------------------------------------------------------------------}
{ TdaABSSession.ValidDatabaseTypes }

function TdaABSSession.ValidDatabaseTypes: TppDatabaseTypes;
begin
  {can add more here as needed}
  Result := [dtOther];
end; {procedure, ValidDatabaseTypes}

{------------------------------------------------------------------------------}
{ TdaABSSession.DefaultSQLType }

function TdaABSSession.DefaultSQLType(aDatabaseType: TppDatabaseType): TppSQLType;
begin
  Result := sqSQL2;
end; {function, DefaultSQLType}

{------------------------------------------------------------------------------}
{ TdaABSSession.GetDatabaseType }

function TdaABSSession.GetDatabaseType(const aDatabaseName: String): TppDatabaseType;
begin
  Result := dtOther;
end; {function, GetDatabaseType}


{******************************************************************************
 *
 ** A B S   D A T A S E T
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.Create }

constructor TdaABSDataSet.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FDataSet := nil;
  FDatabase := nil;
end; {constructor, Create}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.Destroy }

destructor TdaABSDataSet.Destroy;
begin
  FDataSet.Free;
  inherited Destroy;
end; {destructor, Destroy}

{------------------------------------------------------------------------------}
{ TdaABSDataSet.ClassDescription }

class function TdaABSDataSet.ClassDescription: String;
begin
  Result := 'ABSDataSet';
end; {class function, ClassDescription}