xquery.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

    fInputStream: TMemoryStream;
    fOutputStream: TMemoryStream;
    fErrorStream: TMemoryStream;

    Function IsValidFieldName(Const FieldName: String; CheckInPrimary: Boolean): Boolean;
    Function GetRealTableName(Const tn: String): String;
    Function GetRealTableAlias(Const tn: String): String;
    Function CreateSortList(UsingBookmark: Boolean): TxqSortList;
    Procedure SafeCreateResultSet;
    Procedure CreateResultSet;
    Procedure InitializeResultSet;
    Function HasDistinctAggregates: Boolean;
    { define the procedure for the result set creation}
    Procedure DoJoinInWhere;
    Procedure DoInsertStatement;
    Procedure DoUpdateRecord;
    Procedure DoGroupBy;
    Procedure DoOrderBy(TheOrderList: TOrderByList);
    Procedure DoTransform;
    Procedure DoUnion;
    Procedure FreeSubQueries(Var SubQ: TSqlAnalizer);
    Procedure DoIntoTableOperation;
    Procedure DoMassiveUpdates;
  Protected
    Function GetResultSet: TResultSet;
    Procedure SetResultSet(Value: TResultSet);
  Public
    Constructor Create(ParentAnalizer: TSqlAnalizer; XQuery: TCustomxQuery);
    Destructor Destroy; Override;
    Procedure ClearSQL;
    Function ReplaceParams(const SQL: string): String;
    Function HasAggregates: Boolean;
    Function FindDataSetByName(Const Name: String): TDataSet;
    Function FindFieldByName(Const FieldName: String): TField;
    Function QualifiedField(Const FieldName: String; UseAlias: Boolean): String;
    Function CheckIntegrity: Boolean;
    Procedure doSelect;
    Procedure doExecSQL;
    Procedure AddFieldIfNot(Const fieldName: String);
    { methds mainly used internally }
    Procedure AddThisRecord(Dataset: TDataset);

    Property xQuery: TCustomxQuery Read fxQuery Write fxQuery;
    Property Params: TParams Read fParams;
    Property Statement: TSqlStatement Read fStatement Write fStatement;
    Property DefDataSet: TDataSet Read fDefDataSet Write fDefDataSet;
    Property ColumnList: TColumnList Read fColumnList;
    Property IsDistinct: Boolean Read fIsDistinct Write fIsDistinct;
    Property TableList: TTableList Read fTableList;
    Property JoinList: TJoinOnList Read fJoinList;
    Property LJoinCandidateList: TStringList Read fLJoinCandidateList;
    Property RJoinCandidateList: TStringList Read fRJoinCandidateList;
    Property WhereStr: String Read fWhereStr Write fWhereStr;
    Property WhereOptimizeList: TWhereOptimizeList Read fWhereOptimizeList;
    Property OrderByList: TOrderByList Read fOrderByList;
    Property GroupByList: TOrderByList Read fGroupByList;
    Property HavingCol: Integer Read fHavingCol Write fHavingCol;
    Property SubQueryList: TList Read fSubQueryList;
    Property SubQueryKindList: TList Read fSubQueryKindList;
    Property doSelectAll: Boolean Read fDoSelectAll Write fDoSelectAll;
    Property TableAllFields: TStringList Read fTableAllFields;
    Property InsertList: TInsertList Read fInsertList;
    Property UpdateColumnList: TUpdateList Read fUpdateColumnList;
    Property CreateTableList: TCreateTableList Read fCreateTableList Write fCreateTableList;
    Property AlterTableList: TCreateTableList Read fAlterTableList Write fAlterTableList;
    Property IndexUnique: Boolean Read fIndexUnique Write fIndexUnique;
    Property IndexDescending: Boolean Read fIndexDescending Write fIndexDescending;
    Property IndexColumnList: TStringList Read fIndexColumnList Write fIndexColumnList;
    Property IndexName: String Read fIndexName Write fIndexName;
    Property IndexTable: String Read fIndexTable Write fIndexTable;
    Property ResultSet: TResultSet Read GetResultSet Write SetResultSet;
    Property PivotStr: String Read fPivotStr Write fPivotStr;
    Property PivotInList: TStringList Read fPivotInList;
    Property TransformColumnList: TColumnList Read fTransformColumnList;
    Property UnionAnalizer: TSqlAnalizer Read fUnionAnalizer Write fUnionAnalizer;
    Property ParentAnalizer: TSqlAnalizer Read fParentAnalizer Write fParentAnalizer;
    Property SubqueryInPivotPredicate: Boolean Read fSubqueryInPivotPredicate Write fSubqueryInPivotPredicate;
    Property IntoTable: String Read fIntoTable Write fIntoTable;
    Property UserDefinedRange: TUserDefinedRange Read fUserDefinedRange;
    Property WhereContainsOnlyBasicFields: Boolean Read fWhereContainsOnlyBasicFields;
    Property MainWhereResolver: TExprParser Read fMainWhereResolver;
    Property TopNInSelect: Integer read fTopNInSelect write fTopNInSelect;
    Property TopNInGroupBy: Integer read fTopNInGroupBy write fTopNInGroupBy;

    { lex / yacc information }
    Property Parser: TCustomParser Read fParser;
    Property Lexer: TCustomLexer Read fLexer;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TDataSetItem                                          }
  {-------------------------------------------------------------------------------}

  TxDataSetItem = Class(TCollectionItem)
  Private
    fDataSet: TDataSet;
    fAlias: String;
    fTemporal: Boolean;
    Procedure SetDataSet(Value: TDataSet);
    Procedure SetAlias(Const Value: String);
  Protected
    Function GetDisplayName: String; Override;
    Function GetCaption: String;
  Public
    Procedure Assign(Source: TPersistent); Override;
    Property Temporal: boolean Read fTemporal Write fTemporal;
  Published
    Property Alias: String Read fAlias Write SetAlias;
    Property DataSet: TDataSet Read fDataSet Write SetDataSet;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxDataSets                                            }
  {-------------------------------------------------------------------------------}

  TxDataSets = Class(TOwnedCollection)
  Private
    fxQuery: TCustomxQuery;
    fDataSetClass: TDataSetClass;
    Function GetItem(Index: Integer): TxDataSetItem;
    Procedure SetItem(Index: Integer; Value: TxDataSetItem);
  Public
    Constructor Create(AOwner: TPersistent);
    Function IndexOfAlias(Const Alias: String): Integer; { LAS : 05-30-2000 }
    Function Add: TxDataSetItem;
    Property Items[Index: Integer]: TxDataSetItem Read GetItem Write SetItem; Default;
    Property DataSetClass: TDataSetClass Read fDataSetClass Write fDataSetClass;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define Events in TCustomxQuery                               }
  {-------------------------------------------------------------------------------}

  TOptimizeMethod = (omNone, omSetFilter, omSetRange);

  TUDFCheckEvent = Procedure(Sender: tobject;
    Const Identifier: String; Params: TParameterList;
    Var DataType: TExprType; Var MaxLen: Integer;
    Var Accept: Boolean) Of Object;

  TUDFSolveEvent = Procedure(Sender: tobject;
    Const Identifier: String; Params: TParameterList;
    Var Value: variant) Of Object;

  TIndexNeededForEvent = Procedure(Sender: tobject;
    DataSet: TDataSet;
    Const FieldNames: String;
    ActivateIndex: Boolean;
    IsJoining: Boolean;
    Var Accept: Boolean) Of Object;

  TSetRangeEvent = Procedure(Sender: tobject;
    RelOperator: TRelationalOperator;
    DataSet: TDataSet;
    Const FieldNames, StartValues, EndValues: String;
    IsJoining: Boolean) Of Object;

  TCancelRangeEvent = Procedure(Sender: tobject;
    DataSet: TDataSet;
    IsJoining: Boolean) Of Object;

  TSetFilterEvent = Procedure(Sender: tobject;
    DataSet: TDataSet;
    Const Filter: String;
    IsJoining: Boolean;
    Var Handled: Boolean) Of Object;

  TCancelFilterEvent = Procedure(Sender: Tobject;
    DataSet: TDataSet; IsJoining: Boolean) Of Object;

  TBlobNeededEvent = Procedure(Sender: tobject;
    DataSet: TDataSet;
    Var Accept: Boolean) Of Object;

  TxProgressStatus = (psXStart, psXProgress, psXEnd);

  TxProgressEvent = Procedure(Sender: tobject;
    Status: TXProgressStatus;
    Min, Max, Position: Integer) Of Object;

  TCreateTableEvent = Procedure(Sender: tobject;
    CreateTable: TCreateTableItem) Of Object;

  TCreateIndexEvent = Procedure(Sender: tobject;
    Unique, Descending: Boolean;
    Const TableName, IndexName: String;
    ColumnExprList: TStringList) Of Object;

  TDropTableEvent = Procedure(Sender: TObject;
    Const TableName: String) Of Object;

  TDropIndexEvent = Procedure(Sender: TObject;
    Const TableName, IndexName: String) Of Object;

  TSyntaxErrorEvent = Procedure(Sender: tobject;
    Const ErrorMsg, OffendingText: String;
    LineNum, ColNum, TextLen: Integer) Of Object;

  TCancelQueryEvent = Procedure(Sender: TObject;
    Var Cancel: Boolean) Of Object;

  TResolveDatasetEvent = Procedure(Sender: TObject;
    Const Filename: String;
    Var ATableName: String;
    Var Dataset: TDataset) Of Object;

  TQueryScriptErrorEvent = Procedure(Sender: TObject;
    E: Exception;
    Var AbortScript: Boolean) Of Object;

  TQueryFieldNameEvent = Procedure(Sender: TObject;
    FieldIndex: Integer;
    Var FieldName: String) Of Object;

  TSetUserRangeEvent = Procedure(Sender: TObject;
    Dataset: TDataset;
    Const UsingIndex: String;
    ForFields, StartValues, EndValues: TStrings) Of Object;

  TCancelUserRangeEvent = Procedure(Sender: TObject;
    Dataset: TDataset) Of Object;

  {-------------------------------------------------------------------------------}
  {                  Define Bookmark information                                  }
  {-------------------------------------------------------------------------------}

  PRecInfo = ^TRecInfo;
  TRecInfo = Record
    RecordNo: Integer;
    BookmarkFlag: TBookmarkFlag;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TCustomxQuery dataset                                 }
  {-------------------------------------------------------------------------------}

  TCustomxQuery = Class(TDataSet)
  Private
    { Data }
    fDataSets: TxDataSets; {  list of queried datasets               }
    fAllSequenced: Boolean; {  Means all datasets accepts RecNo prop. }
    fResultSet: TResultSet; {  the abstract result set                }
    fRecordCount: Integer; {  current number of record               }
    fRecordSize: Integer; {  the size of the actual data            }
    fRecordBufferSize: Integer; {  data + housekeeping(TRecInfo)          }
    fRecordInfoOffset: Integer; {  offset of RecInfo in record buffer     }
    fRecNo: Integer; {  current record(0 to fRecordCount - 1)  }
    BofCrack: Integer; {  before the first record(crack)         }
    EofCrack: Integer; {  after the last record(crack)           }
    StartCalculated: Integer;
    fIsOpen: Boolean;
    fReadOnly: Boolean;
    fSQL: Tstrings;
    fFilterBuffer: PChar;
    fFilterExpr: TExprParser;
    fPrepared: Boolean;
    fParams: TParams;
    fParamsAsFields: TParamsAsFields;
    fParamCheck: Boolean;
    fDataLink: TDataLink;
    fAutoDisableControls: Boolean;
    fUseDisplayLabel: Boolean;
    fInMemResultSet: Boolean;
    fDateFormat: String;
    fDisabledDataSets: TList;
    fMapFileSize: Longint; { Temporary file max size in bytes     }
    { script section }
    fScriptStatementType: TSQLStatement;
    fScriptIsRunning: Boolean;
    fSQLScript: Tstrings;
    fShowWaitCursor: Boolean;
    fResultSetIsDefined: Boolean;
    fRowsAffected: Integer;
    fWhereOptimizeMethod: TOptimizeMethod;
    fRefFields: TStrings;
    fWithDummies: Boolean;

    { events }
    fOnUDFCheck: TUDFCheckEvent;
    fOnUDFSolve: TUDFSolveEvent;
    fOnProgress: TXProgressEvent;
    fOnIndexNeededFor: TIndexNeededForEvent;
    fOnSetRange: TSetRangeEvent;
    fOnCancelRange: TCancelRangeEvent;
    fOnBlobNeeded: TBlobNeededEvent;
    fOnBeforeQuery: TNotifyEvent;
    fOnAfterQuery: TNotifyEvent;
    fOnCreateTable: TCreateTableEvent;
    fOnAlterTable: TCreateTableEvent;
    fOnCreateIndex: TCreateIndexEvent;
    fOnDropTable: TDropTableEvent;
    fOnDropIndex: TDropIndexEvent;
    fOnSyntaxError: TSyntaxErrorEvent;
    fOnSetFilter: TSetFilterEvent;
    fOnCancelFilter: TCancelFilterEvent;
    fOnCancelQuery: TCancelQueryEvent;
    fOnResolveDataset: TResolveDatasetEvent;
    fOnScriptError: TQueryScriptErrorEvent;
    fOnQueryFieldName: TQueryFieldNameEvent;
    fOnSetUserRange: TSetUserRangeEvent;
    fOnCancelUserRange: TCancelUserRangeEvent;

    Procedure SetParamsAsFields(Value: TParamsAsFields);
    Function GetFieldSize(FieldType: TFieldType; Size: longint): longint;
    Function GetActiveRecordBuffer: PChar;
    Function FilterRecord(Buffer: PChar): Boolean;
    Procedure SetQuery(Value: Tstrings);
    Procedure SetSQLScript(Value: Tstrings);
    Function GetAbout: String;
    Procedure SetAbout(Const Value: String);
    Procedure SetFilterData(Const Text: String);
    Procedure QueryChanged(Sender: tobject);
    Function GetPrepared: Boolean;
    Procedure SetPrepare(Value: Boolean);
    Function GetParamsCount: Word;
    Procedure SetParamsList(Value: TParams);
    Procedure SetDataSource(Value: TDataSource);
    Procedure RefreshParams;
    Procedure SetParamsFromDataSet;
{$IFDEF level4}
    Procedure ReadParamData(Reader: TReader);
    Procedure writeParamData(writer: Twriter);
{$ENDIF}
    Procedure FixDummiesForQuerying(Var Filter: String);
    Procedure ClearTempDatasets;
    Function LocateRecord(Const KeyFields: String; Const KeyValues: Variant;
      Options: TLocateOptions): Integer;
    Procedure SetDataSets(Value: TxDatasets);
  Protected
    Procedure InternalEdit; Override; // editing
    Procedure SetFieldData(Field: TField; Buffer: Pointer); Override; // editing
    Procedure InternalRefresh; Override;
    Function GetDataSource: TDataSource; Override;
    Function AllocRecordBuffer: PChar; Override;
    Procedure FreeRecordBuffer(Var Buffer: PChar); Override;
    Procedure GetBookmarkData(Buffer: PChar; Data: Pointer); Override;
    Function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; Override;

    Function GetRecord(Buffer: PChar; GetMode: TGetMode; doCheck: Boolean): TGetResult; Override;
    Function GetRecordSize: Word; Override;

    Function BCDToCurr(BCD: Pointer; Var Curr: Currency): Boolean;
{$IFNDEF LEVEL5} Override;
{$ENDIF}
    Function CurrToBCD(Const Curr: Currency; BCD: Pointer; Precision, Decimals:
      Integer): Boolean;
{$IFNDEF LEVEL5} Override;
{$ENDIF}

    Procedure InternalClose; Override;
    Procedure InternalFirst; Override;
    Procedure InternalGotoBookmark(Bookmark: Pointer); Override;
    Function InternalBookmarkValid(Bookmark: Pointer): boolean;

    Procedure InternalInitFieldDefs; Override;
    Procedure InternalInitRecord(Buffer: PChar); Override;
    Procedure InternalLast; Override;
    Procedure InternalOpen; Override;
    Procedure InternalSetToRecord(Buffer: PChar); Override;
    Function IsCursorOpen: Boolean; Override;
    Procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); Override;
    Procedure SetBookmarkData(Buffer: PChar; Data: Pointer); Override;
    Function GetCanModify: Boolean; Override;
    Procedure ClearCalcFields(Buffer: PChar); Override;
    Function GetRecordCount: Integer; Override;
    Procedure SetRecNo(Value: Integer); Override;
    Function GetRecNo: Integer; Override;
    Procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); Override;
    Procedure InternalDelete; Override;
    Procedure InternalHandleException; Override;
    Procedure InternalPost; Override;
    Procedure Notification(AComponent: TComponent; Operation: toperation); Override;
    Procedure SetFilterText(Const Value: String); Override;
    Procedure SetFiltered(Value: Boolean); Override;
    Procedure FixDummiesForFilter(Var Filter: String); Dynamic;
{$IFDEF level4}
    Procedure DefineProperties(Filer: TFiler); Override;
{$ENDIF}