?? myldbrelationalalgebra.pas
字號:
unit MYLDBRelationalAlgebra;
interface
{$I MYLDBVer.inc}
uses Windows, Classes, Db, SysUtils, Math,
// MYLDBoluteDatabase units
{$IFDEF DEBUG_LOG}
MYLDBDebug,
{$ENDIF}
MYLDBConst,
MYLDBConverts,
MYLDBExcept,
MYLDBBase,
MYLDBTypes,
MYLDBVariant
;
type
TMYLDBFieldLink = record
FieldName: String; // table field name
DisplayName: String; // result field name
FieldType: TMYLDBAdvancedFieldType;
FieldPrecision: Integer;
FieldSize: Integer;
BLOBCompressionAlgorithm: Byte;
BLOBCompressionMode: Byte;
BLOBBlockSize: Integer;
AO: Pointer; // was TMYLDBAO 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; // TMYLDBExpression
end;
// fields (expressions) list in select
TMYLDBSelectListItem = record
TableName: String; // 'table1.' | 't1'
AllFields: Boolean; // 'table1.*' ?
FieldName: String; // field1
IsExpression: Boolean; // field or expr?
IsDuplicatedField: Boolean; // duplicated field?
ValueExpr: TObject; // TMYLDBExpression
Pseudonym: String; // field1 as f1
end;
// array of fields
TMYLDBFields = class
public
Items: array of TMYLDBSelectListItem; // fields
ItemCount: Integer; // length
// creates
constructor Create;
// adds item to the end
procedure Append(var Item: TMYLDBSelectListItem);
end;
// base class for relational algebra operations
TMYLDBAO = class (TObject)
public
FIsRootAO: Boolean;
FIsAOTable: Boolean;
FIsAOGroupBy: Boolean;
FFilterExpr: TObject; // TMYLDBExpression
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: TMYLDBIntegerArray;
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: TMYLDBVariant;
protected
FFieldLinks: array of TMYLDBFieldLink;
public
FLeftAO,FRightAO: TMYLDBAO;
protected
procedure InternalCreate(
LeftAO: TMYLDBAO = nil;
RightAO: TMYLDBAO = 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: TMYLDBAO; ParentCursor: TMYLDBCursor); 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 TMYLDBAO
procedure SetResultFields(var FieldRefs: array of TMYLDBSelectListItem;
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: TMYLDBIntegerArray = 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: TMYLDBVariant;
FieldNo: Integer;
bCopy: Boolean = False;
AccessToHidden: Boolean = False
);
function GetFieldType(FieldNo: Integer): TMYLDBAdvancedFieldType; overload;
function GetFieldSize(FieldNo: Integer): Integer;
function GetFieldPrecision(FieldNo: Integer): 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
TMYLDBAOTable = class (TMYLDBAO)
private
FDatabase: TObject;
public
constructor Create(
TableName: string;
TableAlias: string;
DB: TObject;
Table: TDataset
);
destructor Destroy; override;
procedure Execute(IsRootAO: Boolean; ParentQueryAO: TMYLDBAO; ParentCursor: TMYLDBCursor); override;
// sets projection
procedure SetResultFields(var FieldRefs: array of TMYLDBSelectListItem;
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
TMYLDBAOJoin = class (TMYLDBAO)
private
FDekart: Boolean;
FOuterJoin: Boolean;
FInnerJoin: Boolean;
FJoinType: TMYLDBJoinType;
FFields1: TMYLDBIntegerArray;
FFields2: TMYLDBIntegerArray;
FJoinCondition: TObject;
// inner / outer joins
FCompareResult: TMYLDBCompareResult;
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: TMYLDBAO;
RightChild: TMYLDBAO;
JoinType: TMYLDBJoinType;
IsNatural: Boolean;
FieldList1: TMYLDBFields; // join fields
FieldList2: TMYLDBFields; // field1 = field2
JoinCondition: TObject
);
destructor Destroy; override;
procedure Execute(IsRootAO: Boolean; ParentQueryAO: TMYLDBAO; ParentCursor: TMYLDBCursor); override;
public
property IsMaterialized;
property FieldCount;
property RecordCount;
property ResultDataset;
property Eof;
property OuterJoin: Boolean read FOuterJoin;
end; // TMYLDBAOJoin
TMYLDBAOUnion = class (TMYLDBAO)
private
FEof: Boolean; // Eof is set
FUnionType: TMYLDBUnionType;
FFields1: TMYLDBIntegerArray;
FFields2: TMYLDBIntegerArray;
FCompareResult: TMYLDBCompareResult;
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: TMYLDBAO;
RightChild: TMYLDBAO;
UnionType: TMYLDBUnionType;
ParentQueryAO: TMYLDBAO;
ParentCursor: TMYLDBCursor;
IsCorresponding: Boolean = False;
bDistinct: Boolean = True;
FieldList: TMYLDBFields=nil // corresponding fields
);
destructor Destroy; override;
public
property IsMaterialized;
property FieldCount;
property RecordCount;
property ResultDataset;
property Eof;
end; // TMYLDBAOUnion - union, intersect, except
// table expression
TMYLDBAOTableExpr = class (TMYLDBAO)
private
procedure ReplacePseudonymsInIndexFields;
procedure AddHiddenIndexFields;
protected
procedure InternalFirst; override;
procedure InternalNext; override;
function InternalGetEof: Boolean; override;
function InternalGetRecordCount: Integer; override;
public
constructor Create(
Child: TMYLDBAO
);
// sets Top row count
procedure SetTopRowCount(FirstRowNo, TopRowCount: Integer); override;
procedure Execute(IsRootAO: Boolean; ParentQueryAO: TMYLDBAO; ParentCursor: TMYLDBCursor); override;
public
property IsMaterialized;
property FieldCount;
property RecordCount;
property ResultDataset;
property Eof;
end;
// table expression
TMYLDBAOGroupBy = class (TMYLDBAO)
protected
FTempDataset: TDataset;
FFirstTimeCalled: Boolean; // true if Next called First time
FAllFields: Boolean;
FFields: TMYLDBIntegerArray;
FCompareResult: TMYLDBCompareResult;
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 TMYLDBSelectListItem;
bDistinct: Boolean); override;
constructor Create(
Child: TMYLDBAO;
FieldList: TMYLDBFields;
var FieldRefs: array of TMYLDBSelectListItem
);
destructor Destroy; override;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -