absrelationalalgebra.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

unit ABSRelationalAlgebra;

interface

{$I ABSVer.inc}

uses Windows, Classes, Db, SysUtils, Math,

// AbsoluteDatabase units

 {$IFDEF DEBUG_LOG}
 ABSDebug,
 {$ENDIF}
 ABSConst,
 ABSConverts,
 ABSExcept,
 ABSBase,
 ABSTypes,
 ABSVariant
 ;

type

 TABSFieldLink = record
  FieldName:                String;   // table field name
  DisplayName:              String;   // result field name
  FieldType:                TABSAdvancedFieldType;
  FieldPrecision:           Integer;
  FieldSize:                Integer;
  BLOBCompressionAlgorithm: Byte;
  BLOBCompressionMode:      Byte;
  BLOBBlockSize:            Integer;
  AO:                       Pointer;  // was TABSAO type, CB4 bug fix
  Dataset:                  TDataset; // dataset
  IsHidden:                 Boolean;
  FieldNo:                  Integer;  // field number in AO or FieldNo
  IsExpression:             Boolean;  // Expression or field?
  IsAggregate:              Boolean;  // Expression is aggregate (contains agg. functions)?
  Expr:                     TObject;  // TABSExpression
 end;

 // fields (expressions) list in select
 TABSSelectListItem = record
  TableName:    String;   // 'table1.' | 't1'
  AllFields:    Boolean;  // 'table1.*' ?
  FieldName:    String;   // field1
  IsExpression: Boolean;  // field or expr?
  IsDuplicatedField: Boolean;  // duplicated field?
  ValueExpr:    TObject;  // TABSExpression
  Pseudonym:    String;   // field1 as f1
 end;

 // array of fields
 TABSFields = class
 public
   Items:       array of TABSSelectListItem; // fields
   ItemCount:   Integer;                     // length
   // creates
   constructor Create;
   // adds item to the end
   procedure Append(var Item: TABSSelectListItem);
 end;


 // base class for relational algebra operations
 TABSAO = class (TObject)
 public
  FIsRootAO:                  Boolean;
  FIsAOTable:                 Boolean;
  FIsAOGroupBy:               Boolean;
  FFilterExpr:                TObject; // TABSExpression
  FTopRowCount:               Int64;
  FFirstRowNo:                Int64;
  FHasSetResultFields:        Boolean;
  FResultTableName:           String; // for SELECT INTO optimization
 protected
  FResultInMemory:            Boolean; // for SELECT INTO optimization
  FResultImmediate:           Boolean; // for SELECT INTO optimization
  FResultDatabaseName:        String; // for SELECT INTO optimization
  FTableName:                 String;
  FTableAlias:                String;
  FIsMaterialized:            Boolean;
  FResultDataset:             TDataset; // result dataset
  FResultFieldsOrder:         TABSIntegerArray;
  FFieldCount:                Integer;
  FLeftAONull:                Boolean;
  FRightAONull:               Boolean;
  FDistinctApplied:           Boolean;
  FDistinctFields:            String;
  FDistinctFieldCount:        Integer;
  FDistinctFieldsMap:         array of Integer;
  FResultIndexFieldsList:             TStringList;
  FResultIndexAscDescFieldsList:      TStringList;
  FResultIndexCaseInsFieldsList:      TStringList;
  FExpressionsExists:         Boolean;
  FIsLocked:                  Boolean;
  FDisableTempFiles:          Boolean;
  FValue:                      TABSVariant;
 protected
  FFieldLinks:                array of TABSFieldLink;
 public
  FLeftAO,FRightAO:           TABSAO;
 protected
 procedure InternalCreate(
                      LeftAO:     TABSAO = nil;
                      RightAO:    TABSAO = nil;
                      TableName:  String = '';
                      TableAlias: String = ''
                      );
  // navigating
  procedure InternalFirst; virtual;
  procedure InternalNext; virtual;
  function InternalGetEof: Boolean; virtual;
  function InternalGetRecordCount: Integer; virtual;
  procedure First; virtual;
  procedure Next; virtual;
  function GetEof: Boolean; virtual;
  function GetRecordCount: Integer; virtual;
  // sets names to FieldLinks list and renames duplicate names
  procedure SetFieldNames; virtual;
  // materialization routines
  function CreateIndexForMaterialize(BeforeCreateTable: Boolean): String;
  procedure CreateTableForMaterialize(
                                            FieldList:  TStringList;
                                            AliasList:  TStringList
                                      );
  procedure FillTableForMaterialize;
  procedure ReplaceInIndexAliasesToFields(FieldList, AliasList,
                                          FResultIndexFieldsList: TStringList);
  procedure FinalizeMaterialize(
                                            FieldList:  TStringList;
                                            AliasList:  TStringList
                                );

  // materializes AO
  procedure DoMaterialize;

 public
  destructor Destroy; override;
  // gets all result records
  procedure Execute(IsRootAO: Boolean; ParentQueryAO: TABSAO; ParentCursor: TABSCursor); virtual;
  function LockTables: Boolean;
  function UnlockTables: Boolean;
  function OpenTables: Boolean;
  function CloseTables: Boolean;

  // sets filter
  procedure SetFilter(FilterExpr: TObject);
  // for SELECT INTO optimization
  procedure SetResultTable(InMemory, Immediate: Boolean; TableName: String; DatabaseName: String);
  // sets Top row count
  procedure SetTopRowCount(FirstRowNo, TopRowCount: Integer); virtual;
  // applies distinct
  procedure ApplyDistinct(DistinctFields: String);
  // sets projection for other TABSAO
  procedure SetResultFields(var FieldRefs: array of TABSSelectListItem;
                            bDistinct: Boolean); virtual;
  // mapping function - return number of found fields and found field No
  // also optionally unhides fields in AO
  function FieldExists(
                  FieldName, TableName: String;
                  Unhide:               Boolean;
                  FieldNumbers:         TABSIntegerArray = nil;
                  UnhideChildrenOnly:   Boolean = False;
                  ScanOnlyVisibleFields: Boolean = false
                      ): Integer; virtual;
  function FindFieldInFieldLinks(FieldName: String; var FieldNo: Integer): Boolean;
  function GetFieldName(FieldNo: Integer; ApplyOrderBy: Boolean = False): string;
  // return FieldName if field is not hidden and column name = field name or display name
  function GetFieldNameByColumnName(ColumnName: String): string;
  function GetFieldNameByColumnNo(ColumnNo: Integer): string;
  function GetFieldNameByVisibleNumber(VisibleFieldNo: Integer): String;
  function GetFieldNoByVisibleNumber(VisibleFieldNo: Integer): Integer;
  procedure GetFieldValue(
                        Value:      TABSVariant;
                        FieldNo:        Integer;
                        bCopy:          Boolean = False;
                        AccessToHidden: Boolean = False
                        );
  function GetFieldType(FieldNo: Integer): TABSAdvancedFieldType; overload;
  function GetFieldSize(FieldNo: Integer): Integer;
  function GetFieldPrecision(FieldNo: Integer): Integer;
  procedure CopyFieldValue(SrcFieldNo,DestFieldNo: Integer);
  function GetFieldDatsetAndFieldNo(var SrcFieldDatset: TDataset;
                                    var SrcFieldDatasetFieldNo: Integer): Boolean;
  // sets index
 private
  procedure InternalSetDistinct;
  procedure InternalSetIndex(ToClearFields: Boolean = True);
  procedure CreateResultIndexLists(ToClear: Boolean = True);
  procedure FreeResultIndexLists;
  procedure AddFieldLink(FieldLinkNo: Integer; SkipHiddenFields: Boolean = True);
 public
  procedure SetIndex(IndexFieldNames, DescFields, CaseInsensitiveFields: string);
    virtual;
  property IsMaterialized: Boolean read FIsMaterialized;
  property FieldCount: Integer read FFieldCount;
  property RecordCount: Integer read GetRecordCount;
  property ResultDataset: TDataset read FResultDataset;
  property Eof: Boolean read GetEof;
  property TableAlias: String read FTableAlias write FTableAlias;
 end;

 // table
 TABSAOTable = class (TABSAO)
 private
  FDatabase: TObject;
 public
  constructor Create(
                      TableName:  string;
                      TableAlias: string;
                      DB: TObject;
                      Table: TDataset
                      );
  destructor Destroy; override;
  procedure Execute(IsRootAO: Boolean; ParentQueryAO: TABSAO; ParentCursor: TABSCursor); override;
  // sets projection
  procedure SetResultFields(var FieldRefs: array of TABSSelectListItem;
                      bDistinct: Boolean); override;
  function TransferIndexToParentIfNeeded(var FieldNamesList, AscDescList, CaseSensitivityList: TStringList): Boolean;

  property IsMaterialized;
  property FieldCount;
  property RecordCount;
  property ResultDataset;
  property Eof;
 end;


 // joins and dekart
 TABSAOJoin = class (TABSAO)
 private
  FDekart:    Boolean;
  FOuterJoin: Boolean;
  FInnerJoin: Boolean;

  FJoinType:  TABSJoinType;
  FFields1:   TABSIntegerArray;
  FFields2:   TABSIntegerArray;
  FJoinCondition: TObject;

  // inner / outer joins
  FCompareResult: TABSCompareResult;
  FEqualStarted:      Boolean; // true if equal values in both AO
  FFirstTimeCalled:   Boolean; // true if Next called First time
  FEof:               Boolean; // Eof is set
  FRightBeginBookmark:Pointer;
  FRightEndBookmark:  Pointer;
  FBothNullsStarted:  Boolean;
  FLeftAOEmpty:       Boolean;
  FRightAOEmpty:      Boolean;
  FLinkCount:         Integer;
  FFieldsLink:        Boolean;

 protected
  // records are called Equal if all their join attributes are equal
  procedure CompareRecords; overload;
  procedure InternalFirst; override;
  procedure InternalNext; override;
  function InternalGetEof: Boolean; override;
  function InternalGetRecordCount: Integer; override;
 public
  constructor Create(
                      LeftChild:  TABSAO;
                      RightChild: TABSAO;
                      JoinType:   TABSJoinType;
                      IsNatural:  Boolean;
                      FieldList1: TABSFields; // join fields
                      FieldList2: TABSFields; // field1 = field2
                      JoinCondition: TObject
                      );
  destructor Destroy; override;
  procedure Execute(IsRootAO: Boolean; ParentQueryAO: TABSAO; ParentCursor: TABSCursor); override;

 public
  property IsMaterialized;
  property FieldCount;
  property RecordCount;
  property ResultDataset;
  property Eof;
  property OuterJoin: Boolean read FOuterJoin;
 end; // TABSAOJoin


 TABSAOUnion = class (TABSAO)
 private
  FEof:               Boolean; // Eof is set
  FUnionType:         TABSUnionType;
  FFields1:           TABSIntegerArray;
  FFields2:           TABSIntegerArray;
  FCompareResult:     TABSCompareResult;
  FFirstTimeCalled:   Boolean; // true if Next called First time
  FShowLeft:          Boolean; // if then leftAO records will be added otherwise right
 protected
  // records are called Equal if all their join attributes are equal
  procedure CompareRecords;
  procedure ShowLeftAO;
  procedure ShowRightAO;
  procedure InternalFirst; override;
  procedure InternalNext; override;
  function InternalGetEof: Boolean; override;
  function InternalGetRecordCount: Integer; override;
 public
  constructor Create(
                      LeftChild:  TABSAO;
                      RightChild: TABSAO;
                      UnionType:   TABSUnionType;
                      ParentQueryAO: TABSAO;
                      ParentCursor: TABSCursor;
                      IsCorresponding:  Boolean = False;
                      bDistinct: Boolean = True;
                      FieldList: TABSFields=nil // corresponding fields
                      );
  destructor Destroy; override;
 public
  property IsMaterialized;
  property FieldCount;
  property RecordCount;
  property ResultDataset;
  property Eof;
 end; // TABSAOUnion - union, intersect, except

 // table expression
 TABSAOTableExpr = class (TABSAO)
 private
  procedure ReplacePseudonymsInIndexFields;
  procedure AddHiddenIndexFields;

 protected
  procedure InternalFirst; override;
  procedure InternalNext; override;
  function InternalGetEof: Boolean; override;
  function InternalGetRecordCount: Integer; override;
 public
  constructor Create(
                     Child: TABSAO
                    );
  // sets Top row count
  procedure SetTopRowCount(FirstRowNo, TopRowCount: Integer); override;
  procedure Execute(IsRootAO: Boolean; ParentQueryAO: TABSAO; ParentCursor: TABSCursor); override;
 public
  property IsMaterialized;
  property FieldCount;
  property RecordCount;
  property ResultDataset;
  property Eof;
 end;

 // table expression
 TABSAOGroupBy = class (TABSAO)
 protected
  FTempDataset:       TDataset;
  FFirstTimeCalled:   Boolean; // true if Next called First time
  FAllFields:         Boolean;
  FFields:            TABSIntegerArray;
  FCompareResult:     TABSCompareResult;
  FGroupFinished:     Boolean;
  FEOF:               Boolean;
  GroupByFields: string;
 protected
  // records are called Equal if all their join attributes are equal
  procedure CompareRecords;
  procedure InternalFirst; override;
  procedure InternalNext; override;
  function InternalGetEof: Boolean; override;
  function InternalGetRecordCount: Integer; override;
  function IsCountAll: Boolean;
  procedure DoCountAll;
 public
  // sets projection
  procedure SetResultFields(var FieldRefs: array of TABSSelectListItem;
                      bDistinct: Boolean); override;
  constructor Create(
                     Child: TABSAO;
                     FieldList: TABSFields;
                     var FieldRefs: array of TABSSelectListItem
                    );
  destructor Destroy; override;
 public
  property IsMaterialized;