⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 xquery.pas

📁 TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,
💻 PAS
📖 第 1 页 / 共 5 页
字号:
Unit xquery;

{*******************************************************}
{                                                       }
{       TxQuery dataset implementation                  }
{                                                       }
{       Copyright (c) 1999-2002 Alfonso moreno          }
{                                                       }
{       Written by:                                     }
{       Alfonso moreno                                  }
{       Hermosillo, Sonora, Mexico.                     }
{       Internet: amoreno@sigmap.com                    }
{                 luisarvayo@yahoo.com                  }
{       URL: http://www.sigmap.com/txquery.htm          }
{                                                       }
{*******************************************************}

{$I XQ_FLAG.INC}
Interface

Uses
  SysUtils, Windows, Classes, Controls, Forms, Db,
  XQMiscel, xqbase, Qlexlib, Qyacclib, Qbaseexpr, QExprYacc, XQJoins
{$IFDEF LEVEL3}
  , DBTables
{$ENDIF}
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;

Type

  {-------------------------------------------------------------------------------}
  {                  Define forward declarations and class definitions            }
  {-------------------------------------------------------------------------------}

  TResultSet = Class;
  TxqFields = Class;
  TCustomxQuery = Class;
  TDataSetClass = Class Of TDataSet;
  TSqlAnalizer = Class;

  {-------------------------------------------------------------------------------}
  {                  Define TxqField                                              }
  {-------------------------------------------------------------------------------}

  TxqField = Class
  Private
    fFields: TxqFields; { the list of fields that this field belongs to                                  }
    fFieldName: String; { the column name sample: Customer.Addr1                                         }
    fAlias: String; { the alias of the field: Customer.Addr1 main_address                            }
    fDataType: TExprType; { the data type (ttstring, ttFloat, ttInteger, ttBoolean)                        }
    fDataSize: Word; { calculated datasize for ttstring (used in TxQuery)                             }
    fBufferOffset: Integer; { offset in the list of buffers for every record                                 }
    fFieldOffset: Integer; { Offset in the buffer in TxQuery dataset                                        }
    fReadOnly: Boolean; { = true, means that comes from single field, false = expression or joined field }
    fSourceField: TField; { Field that originated this column, =nil if it is an expression                 }
    fCastType: Word; { field must be casted to this type on creation                                  }
    fCastLen: Word; { field must be of this len if CastType = RW_CHAR                                }
    fUseDisplayLabel: Boolean; { true = use labels from SrcField.DisplayLabel for column alias                   }
    fFieldNo: Integer; { the number of the field, in base 1                                             }
    Function GetData(Buffer: Pointer): Boolean;
    Procedure SetData(Buffer: Pointer);
    Function GetColWidth: Integer;
    Function GetIsNull: Boolean;
    { LAS : 5/JUN/2002 }
    Procedure SetIsNull;
  Protected
    Function GetAsVariant: Variant; Virtual;
    Procedure SetAsVariant(const Value: Variant);
    Procedure SetVarValue(const Value: Variant); Virtual; Abstract;
    Function GetAsstring: String; Virtual;
    Procedure SetAsstring(Const Value: String); Virtual;
    Function GetAsFloat: double; Virtual;
    Procedure SetAsFloat(Value: double); Virtual;
    Function GetAsInteger: Longint; Virtual;
    Procedure SetAsInteger(Value: Longint); Virtual;
    Function GetAsBoolean: Boolean; Virtual;
    Procedure SetAsBoolean(Value: Boolean); Virtual;
    Procedure SetDataType(Value: TExprType);
  Public
    Constructor Create(Fields: TxqFields; FieldNo: Integer); Virtual;
    Procedure Clear; Virtual; Abstract;

    Property FieldName: String Read fFieldName Write fFieldName;
    Property Alias: String Read fAlias Write fAlias;
    Property FieldNo: Integer Read fFieldNo;
    Property DataType: TExprType Read fDataType Write fDataType;
    Property DataSize: Word Read fDataSize Write fDataSize;
    Property ReadOnly: Boolean Read fReadOnly Write fReadOnly;
    Property FieldOffset: Integer Read fFieldOffset Write fFieldOffset;
    Property SourceField: TField Read fSourceField Write fSourceField;
    Property CastType: Word Read fCastType Write fCastType;
    Property CastLen: Word Read fCastLen Write fCastLen;
    Property ColWidth: Integer Read GetColWidth;
    Property BufferOffset: Integer Read fBufferOffset Write fBufferOffset;
    Property UseDisplayLabel: Boolean Read fUseDisplayLabel Write fUseDisplayLabel;

    Property AsVariant: Variant Read GetAsVariant Write SetAsVariant;
    Property Asstring: String Read GetAsstring Write SetAsstring;
    Property AsFloat: double Read GetAsFloat Write SetAsFloat;
    Property AsInteger: Longint Read GetAsInteger Write SetAsInteger;
    Property AsBoolean: Boolean Read GetAsBoolean Write SetAsBoolean;
    Property IsNull: Boolean Read GetIsNull;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxqStringField                                        }
  {-------------------------------------------------------------------------------}

  TxqStringField = Class(TxqField)
  Private
    Function GetValue(Var Value: String): Boolean;
  Protected
    Function GetAsVariant: Variant; Override;
    Procedure SetVarValue(const Value: Variant); Override;
    Function GetAsstring: String; Override;
    Procedure SetAsstring(Const Value: String); Override;
    Function GetAsFloat: double; Override;
    Procedure SetAsFloat(Value: double); Override;
    Function GetAsInteger: Longint; Override;
    Procedure SetAsInteger(Value: Longint); Override;
    Function GetAsBoolean: Boolean; Override;
    Procedure SetAsBoolean(Value: Boolean); Override;
  Public
    Constructor Create(Fields: TxqFields; FieldNo: Integer); Override;
    Procedure Clear; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxqFloatField                                         }
  {-------------------------------------------------------------------------------}

  TxqFloatField = Class(TxqField)
  Private
  Protected
    Function GetAsVariant: Variant; Override;
    Procedure SetVarValue(const Value: Variant); Override;
    Function GetAsFloat: double; Override;
    Function GetAsInteger: Longint; Override;
    Function GetAsstring: String; Override;
    Procedure SetAsFloat(Value: double); Override;
    Procedure SetAsInteger(Value: Longint); Override;
    Procedure SetAsstring(Const Value: String); Override;
  Public
    Constructor Create(Fields: TxqFields; FieldNo: Integer); Override;
    Procedure Clear; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxqIntegerField                                       }
  {-------------------------------------------------------------------------------}

  TxqIntegerField = Class(TxqField)
  Private
  Protected
    Function GetAsVariant: Variant; Override;
    Procedure SetVarValue(const Value: Variant); Override;
    Function GetAsFloat: double; Override;
    Function GetAsInteger: Longint; Override;
    Function GetAsstring: String; Override;
    Procedure SetAsFloat(Value: double); Override;
    Procedure SetAsInteger(Value: Longint); Override;
    Procedure SetAsstring(Const Value: String); Override;
  Public
    Constructor Create(Fields: TxqFields; FieldNo: Integer); Override;
    Procedure Clear; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxqBooleanField                                       }
  {-------------------------------------------------------------------------------}

  TxqBooleanField = Class(TxqField)
  Private
  Protected
    Function GetAsVariant: Variant; Override;
    Procedure SetVarValue(const Value: Variant); Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetAsstring: String; Override;
    Procedure SetAsBoolean(Value: Boolean); Override;
    Procedure SetAsstring(Const Value: String); Override;
  Public
    Constructor Create(Fields: TxqFields; FieldNo: Integer); Override;
    Procedure Clear; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxqFields                                             }
  {-------------------------------------------------------------------------------}

  TxqFields = Class
    fResultSet: TResultSet;
    fItems: TList;
    Function GetCount: Integer;
    Function GetItem(Index: Integer): TxqField;
  Public
    Constructor Create(ResultSet: TResultSet);
    Destructor Destroy; Override;
    Function Add(DataType: TExprType): TxqField;
    Procedure Clear;
    Procedure Delete(Index: Integer);
    Function FindField(Const FieldName: String): TxqField;

    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: TxqField Read GetItem; Default;
    Property ResultSet: TResultSet Read fResultSet;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define abstract TResultSet                                   }
  {-------------------------------------------------------------------------------}

  TResultSet = Class
  Private
    fFields: TxqFields;
    fRecNo: Integer;
    fRecordBufferSize: Integer;
    fSourceDataSet: TDataSet;
    fIsSequenced: Boolean;
  Protected
    Function GetFieldData(Field: TxqField; Buffer: Pointer): Boolean; Virtual;
    Procedure SetFieldData(Field: TxqField; Buffer: Pointer); Virtual; Abstract;
    Function GetIsNull(Field: TxqField): Boolean; Virtual;
    { LAS : 5/JUN/2002 }
    Procedure SetIsNull(Field: TxqField); Virtual;
    Procedure SetRecno(Value: Integer);
    Function GetRecno: Integer;
    Function GetRecordCount: Integer; Virtual;
    Procedure SortWithList(SortList: TxqSortList); Virtual; Abstract;
    Procedure ClearBufferList; Virtual; Abstract;
  Public
    { methods }
    Constructor Create;
    Destructor Destroy; Override;
    Procedure AddField(Const pFieldName, pAlias: String; pDataType: TExprType;
      pDataSize: Integer; pField: TField; pReadOnly: Boolean;
      pCastType: Integer; pCastLen: Integer; pUseDisplayLabel: Boolean);
    Procedure Insert; Virtual; Abstract;
    Procedure Delete; Virtual; Abstract;
    Function FindField(Const FieldName: String): TxqField;
    Function FieldByName(Const FieldName: String): TxqField;
    Procedure Clear; Virtual;
    Procedure SaveToText(Const FileName: String); // debuggin purposes
    Procedure SetSourceBookmark(Bookmark: TBookmark); Virtual; Abstract;
    Function GetSourceBookmark: TBookmark; Virtual; Abstract;
    Procedure FreeSourceBookmark; Virtual; Abstract;

    { properties }
    Property IsSequenced: Boolean Read fIsSequenced Write fIsSequenced;
    Property SourceDataSet: TDataSet Read fSourceDataSet Write fSourceDataSet;
    Property Recno: Integer Read GetRecno Write SetRecno;
    Property RecordCount: Integer Read GetRecordCount;
    Property Fields: TxqFields Read fFields;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TMemResultSet                                         }
  {-------------------------------------------------------------------------------}

  TMemResultSet = Class(TResultSet)
  Private
    fBufferList: TList;
    Function ActiveBuffer: PChar;
  Protected
    Function GetFieldData(Field: TxqField; Buffer: Pointer): Boolean; Override;
    Procedure SetFieldData(Field: TxqField; Buffer: Pointer); Override;
    Function GetIsNull(Field: TxqField): Boolean; Override;
    { LAS : 5/JUN/2002 }
    Procedure SetIsNull(Field: TxqField); Override;
    Function GetRecordCount: Integer; Override;
    Procedure SortWithList(SortList: TxqSortList); Override;
    Procedure ClearBufferList; Override;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure Insert; Override;
    Procedure Delete; Override;
    Procedure Clear; Override;
    Procedure SetSourceBookmark(Bookmark: TBookmark); Override;
    Function GetSourceBookmark: TBookmark; Override;
    Procedure FreeSourceBookmark; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TFileResultSet                                        }
  {-------------------------------------------------------------------------------}

  TFileResultSet = Class(TResultSet)
  Private
    fBufferList: TList;
    fMemMapFile: TMemMapFile;
    fTmpFile: String;
    fBuffer: PChar;
    Function ActiveBuffer: PChar;
  Protected
    Function GetFieldData(Field: TxqField; Buffer: Pointer): Boolean; Override;
    Procedure SetFieldData(Field: TxqField; Buffer: Pointer); Override;
    Function GetIsNull(Field: TxqField): Boolean; Override;
    { LAS : 5/JUN/2002 }
    Procedure SetIsNull(Field: TxqField); Override;
    Function GetRecordCount: Integer; Override;
    Procedure SortWithList(SortList: TxqSortList); Override;
    Procedure ClearBufferList; Override;
  Public
    Constructor Create(MapFileSize: Longint);
    Destructor Destroy; Override;
    Procedure Insert; Override;
    Procedure Delete; Override;
    Procedure Clear; Override;
    Procedure SetSourceBookmark(Bookmark: TBookmark); Override;
    Function GetSourceBookmark: TBookmark; Override;
    Procedure FreeSourceBookmark; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TSqlAnalizer                                          }
  {-------------------------------------------------------------------------------}

  TSqlAnalizer = Class(TObject)
  Private
    fParentAnalizer: TSqlAnalizer; { the parent analizer if this is a subquery       }
    fResultSet: TResultSet; { the Result Set                                  }
    fParams: TParams; { Params passed from TxQuery                      }
    fStatement: TSqlStatement; { The statement: SELECT, UPDATE, etc.             }
    fxQuery: TCustomxQuery; { Linked to this TxQuery                          }
    fDefDataSet: TDataSet; { the default TDataSet                            }
    fColumnList: TColumnList; { SELECT                                          }
    fIsDistinct: Boolean; { syntax: SELECT DISTINCT                         }
    fTableList: TTableList; { FROM                                            }
    fJoinList: TJoinOnList; { JOIN ON                                         }
    fLJoinCandidateList: TStringList; { candidates for converting to join               }
    fRJoinCandidateList: TStringList; {                                                 }
    fWhereStr: String; { WHERE clause expression                         }
    fIsJoinInWhere: Boolean; { JOINing in a where clause                       }
    fJoinInWhereExpres: String;
    fJoinInWhereResolver: TExprParser;
    fMainWhereResolver: TExprParser; { WHERE expression resolver class                 }
    fWhereOptimizeList: TWhereOptimizeList; { used for optimizing the result set generation}
    fOrderByList: TOrderByList; { ORDER BY list                                   }
    fGroupByList: TOrderByList; { GROUP BY list                                   }
    fHavingCol: Integer; { HAVING predicate                                }
    fSubQueryList: TList; { Subqueries in the expression                    }
    fSubQueryKindList: TList; {                                                 }
    fDoSelectAll: Boolean; { syntax: SELECT * FROM...                        }
    fTableAllFields: TStringList; { syntax: SELECT customer.* FROM customer;        }
    fUpdateColumnList: TUpdateList; { UPDATE statement                                }
    fInsertList: TInsertList; { INSERT statement                                }
    fCreateTableList: TCreateTableList; { CREATE TABLE statement                          }
    fAlterTableList: TCreateTableList; { ALTER TABLE statement                          }
    fIndexUnique: Boolean; { CREATE INDEX, DROP TABLE, DROP INDEX statements }
    fIndexDescending: Boolean; {                                                 }
    fIndexColumnList: TStringList; {                                                 }
    fIndexName: String; {                                                 }
    fIndexTable: String; {                                                 }
    fPivotStr: String; { syntax: TRANSFORM...PIVOT                       }
    fPivotInList: TStringList;
    fTransformColumnList: TColumnList; { LAS 25:07:2000 }
    fTransfBaseColumns: Integer;
    fTransfGroupedColumns: Integer;
    fTransfResultSet: TResultSet; { used in the TRANSFORM...PIVOT}
    fUnionAnalizer: TSqlAnalizer; { syntax select_statement UNION second_select_statement }
    fWhereFilter: String; { used to check if a WHERE clause can be filtered }
    fSubqueryInPivotPredicate: Boolean; { syntax: 	transform count(it.AutoId)
    select 'No. of Items' as Items from pe, it
    where  (pe.Title=it.ItDateM)
    and (pe.ReportId=:REPID)
       pivot pe.Title in (select pe.Title by pe order by pe.Title)
  }
    fIntoTable: String; { select * from customer INTO newcust}
    fUserDefinedRange: TUserDefinedRange;
    fWhereContainsOnlyBasicFields: Boolean;
    fTopNInSelect: Integer;
    fTopNInGroupBy: Integer;

    { parameters for lex / yacc follows }
    fParser: TCustomParser;
    fLexer: TCustomLexer;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -