xqbase.pas

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

    Property Items[Index: Integer]: TInsertItem Read GetItem; Default;
  End;

  {-------------------------------------------------------------------------------}
  {                  TSrtField to sort with variable type columns                 }
  {-------------------------------------------------------------------------------}

  TSrtField = Class( TObject )
  Private
    fFields: TSrtFields;
    fDataType: TExprType;
    fDataSize: Integer;
    fDesc: Boolean;
    fBufferOffset: Integer;
    Function GetData( Buffer: Pointer ): Boolean;
    Procedure SetData( Buffer: Pointer );
  Protected
    Function GetAsString: String; Virtual; Abstract;
    Procedure SetAsString( Const Value: String ); Virtual; Abstract;
    Function GetAsFloat: double; Virtual; Abstract;
    Procedure SetAsFloat( Value: double ); Virtual; Abstract;
    Function GetAsInteger: Longint; Virtual; Abstract;
    Procedure SetAsInteger( Value: Longint ); Virtual; Abstract;
    Function GetAsBoolean: Boolean; Virtual; Abstract;
    Procedure SetAsBoolean( Value: Boolean ); Virtual; Abstract;
    Procedure SetDataType( Value: TExprType );
  Public
    Constructor Create( Fields: TSrtFields ); Virtual;

    Property DataType: TExprType Read fDataType Write SetDataType;
    Property DataSize: Integer Read fDataSize Write fDataSize;
    Property Desc: Boolean Read fDesc Write fDesc;
    Property BufferOffset: Integer Read fBufferOffset Write fBufferOffset;

    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;
  End;

  {-------------------------------------------------------------------------------}
  {                  TSrtStringField                                              }
  {-------------------------------------------------------------------------------}

  TSrtStringField = Class( TSrtField )
  Private
    Function GetValue( Var Value: String ): Boolean;
  Protected
    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: TSrtFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TsrtFloatField                                        }
  {-------------------------------------------------------------------------------}

  TSrtFloatField = Class( TSrtField )
  Protected
    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: TSrtFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TsrtIntegerField                                      }
  {-------------------------------------------------------------------------------}

  TSrtIntegerField = Class( TSrtField )
  Protected
    Function GetAsString: String; Override;
    Procedure SetAsString( Const Value: String ); Override;
    Function GetAsInteger: Longint; Override;
    Procedure SetAsInteger( Value: Longint ); Override;
    Function GetAsFloat: double; Override;
    Procedure SetAsFloat( Value: double ); Override;
    Function GetAsBoolean: Boolean; Override;
    Procedure SetAsBoolean( Value: Boolean ); Override;
  Public
    Constructor Create( Fields: TSrtFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TSrtBooleanField                                      }
  {-------------------------------------------------------------------------------}

  TSrtBooleanField = Class( TSrtField )
  Protected
    Function GetAsString: String; Override;
    Procedure SetAsString( Const Value: String ); Override;
    Function GetAsBoolean: Boolean; Override;
    Procedure SetAsBoolean( Value: Boolean ); Override;
    Function GetAsInteger: Longint; Override;
    Procedure SetAsInteger( Value: Longint ); Override;
    Function GetAsFloat: double; Override;
    Procedure SetAsFloat( Value: double ); Override;
  Public
    Constructor Create( Fields: TSrtFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TSrtFields                                            }
  {-------------------------------------------------------------------------------}

  TSrtFields = Class
    fSortList: TxqSortList;
    fItems: TList;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): TSrtField;
  Public
    Constructor Create( SortList: TxqSortList );
    Destructor Destroy; Override;
    Function Add( DataType: TExprType ): TSrtField;
    Procedure Clear;

    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: TSrtField Read GetItem; Default;
    Property SortList: TxqSortList Read fSortList;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TxqSortList                                           }
  {-------------------------------------------------------------------------------}
  TxqSortList = Class( TObject )
  Private
    fFields: TSrtFields;
    fRecNo: Integer;
    fRecordBufferSize: Integer;
    fUsingBookmark: Boolean;
    fSelected: TList;
    fBofCrack: Boolean;
    fEofCrack: Boolean;
    fFilterRecno: Integer;
    fBookmarkedDataset: TDataset; { Used for calling to TDataset.FreeBookmark }

    Function ActiveBuffer: PChar; Virtual; Abstract;
    Function DoCompare( N: Integer; Const KeyValue: Variant ): Integer;
    Function Find( Const KeyValue: Variant; Var Index: Integer ): Boolean;
  Protected
    Function GetFieldData( Field: TSrtField; Buffer: Pointer ): Boolean; Virtual; Abstract;
    Procedure SetFieldData( Field: TSrtField; Buffer: Pointer ); Virtual; Abstract;
    Procedure SetRecno( Value: Integer );
    Function GetRecno: Integer;
    Procedure SetSourceRecno( Value: Integer ); Virtual; Abstract;
    Function GetSourceRecno: Integer; Virtual; Abstract;
    Function GetRecordCount: Integer; Virtual; Abstract;
  Public
    Constructor Create( UsingBookmark: Boolean );
    Destructor Destroy; Override;
    Procedure AddField( pDataType: TExprType; pDataSize: Integer;
      pDescending: Boolean );
    Procedure Insert; Virtual; Abstract;
    Procedure Sort;
    Procedure Exchange( Recno1, Recno2: Integer ); Virtual; Abstract;
    Procedure Clear; Virtual; Abstract;
    Function IsEqual( Recno1, Recno2: Integer ): Boolean;
    Procedure Filter( Const KeyValue: Variant );
    Procedure First;
    Procedure Next;
    Function Eof: Boolean;
    Function Bof: Boolean;

    Property Count: Integer Read GetRecordCount;
    Property Recno: Integer Read GetRecno Write SetRecno;
    Property FilterRecno: Integer Read FFilterRecno Write FFilterRecno;
    Property SourceRecno: Integer Read GetSourceRecno Write SetSourceRecno;
    Property Fields: TSrtFields Read fFields;
    Property BookmarkedDataset: TDataset Read fBookmarkedDataset Write fBookmarkedDataset;
  End;

  TMemSortList = Class( TxqSortList )
  Private
    fBufferList: TList;
    Function ActiveBuffer: PChar; Override;
  Protected
    Function GetFieldData( Field: TSrtField; Buffer: Pointer ): Boolean; Override;
    Procedure SetFieldData( Field: TSrtField; Buffer: Pointer ); Override;
    Function GetRecordCount: Integer; Override;
    Procedure SetSourceRecno( Value: Integer ); Override;
    Function GetSourceRecno: Integer; Override;
  Public
    Constructor Create( UsingBookmark: Boolean );
    Destructor Destroy; Override;
    Procedure Insert; Override;
    Procedure Exchange( Recno1, Recno2: Integer ); Override;
    Procedure Clear; Override;
  End;

  TFileSortList = Class( TxqSortList )
  Private
    fBufferList: TList;
    fMemMapFile: TMemMapFile;
    fTmpFile: String;
    fBuffer: PChar;
    Function ActiveBuffer: PChar; Override;
  Protected
    Function GetFieldData( Field: TSrtField; Buffer: Pointer ): Boolean; Override;
    Procedure SetFieldData( Field: TSrtField; Buffer: Pointer ); Override;
    Function GetRecordCount: Integer; Override;
    Procedure SetSourceRecno( Value: Integer ); Override;
    Function GetSourceRecno: Integer; Override;
  Public
    Constructor Create( UsingBookmark: Boolean; MapFileSize: Longint );
    Destructor Destroy; Override;
    Procedure Insert; Override;
    Procedure Exchange( Recno1, Recno2: Integer ); Override;
    Procedure Clear; Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TUserDefinedRange                                     }
  {-------------------------------------------------------------------------------}

  { this class is used for handling this kind of syntax:
    SELECT * FROM MOVES SET RANGE FROM 1000 TO 3000 USING INDEX "CUSTNO_INDEX" ;

    and is implemented only in certain situations where it is possible to
    optimize by end-user .
  }

  TUserDefinedRange = Class
  Private
    FForFields: TStrings;
    FStartValues: TStrings;
    FEndValues: TStrings;
    FUsingIndex: String;
    FStartResolvers: TList;
    FEndResolvers: TList;
    Procedure ClearResolvers;
  Public
    Constructor Create;
    Destructor Destroy; Override;

    Property ForFields: TStrings Read FForFields;
    Property StartValues: TStrings Read FStartValues;
    Property EndValues: TStrings Read FEndValues;
    Property UsingIndex: String Read FUsingIndex Write FUsingIndex;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TMemMapFile                                           }
  {-------------------------------------------------------------------------------}

  TMemMapFile = Class( TObject )
  Private
    fFileName: String;
    fSize: Longint;
    fFileSize: Longint;
    fFileMode: Integer;
    fFileHandle: Integer;
    fMapHandle: Integer;
    fData: PChar;
    fMapNow: Boolean;
    fPosition: Longint;
    fVirtualSize: Longint;

    Procedure AllocFileHandle;
    Procedure AllocFileMapping;
    Procedure AllocFileView;
    Function GetSize: Longint;
  Public
    Constructor Create( FileName: String; FileMode: integer;
      Size: integer; MapNow: Boolean ); Virtual;
    Destructor Destroy; Override;
    Procedure FreeMapping;
    Procedure Read( Var Buffer; Count: Longint );
    Procedure Write( Const Buffer; Count: Longint );
    Procedure Seek( Offset: Longint; Origin: Word );

    Property Data: PChar Read fData;
    Property Size: Longint Read GetSize;
    Property VirtualSize: Longint Read fVirtualSize;
    Property Position: Longint Read fPosition;
    Property FileName: String Read fFileName;
    Property FileHandle: Integer Read fFileHandle;
    Property MapHandle: Integer Read fMapHandle;
  End;

  {---------------------------------------------------------------------------}
  {                  Define TParamsAsFieldsItem                               }
  {---------------------------------------------------------------------------}

  TParamsAsFieldsItem = Class( TCollectionItem )
  Private
    fName: string;
    fValue: string;
    Procedure SetName( const Value: string );
    Procedure SetValue( Const Value: String );
  Protected
    Function GetDisplayName: String; Override;
  Public
    Procedure Assign( Source: TPersistent ); Override;
  Published
    Property Name: String Read fname Write SetName;
    Property Value: String Read fValue Write SetValue;
  End;

  {----------------------------------------------------------------------------}
  {                  Define TParamsAsFields                                    }
  {----------------------------------------------------------------------------}

  TParamsAsFields = Class( TOwnedCollection )
  Private
    Function GetItem( Index: Integer ): TParamsAsFieldsItem;
    Procedure SetItem( Index: Integer; Value: TParamsAsFieldsItem );
  Public
    Constructor Create( AOwner: TPersistent );
    Function Add: TParamsAsFieldsItem;
    function ParamByName(const Value: string): TParamsAsFieldsItem;
    Property Items[Index: Integer]: TParamsAsFieldsItem Read GetItem Write SetItem; Default;
  End;

Implementation

Uses
  xquery, xqconsts
{$IFDEF LEVEL6}
  , Variants
{$ENDIF}
  ;

{-------------------------------------------------------------------------------}
{                  Implement TColumnItem                                        }
{-------------------------------------------------------------------------------}

Constructor TColumnItem.Create( ColumnList: TColumnList );
Begin
  Inherited Create;
  fColumnList := ColumnList;
  fAggregateList := TAggregateList.Create;
  fSubQueryList := TList.Create;
  fAutoFree := True;
End;

Destructor TColumnItem.Destroy;
Var
  i: Integer;
Begin
  fAggregateList.Free;
  If fAutoFree And Assigned( fResolver ) Then
    fResolver.Free;
  For i := 0 To fSubQueryList.Count - 1 Do
    TSqlAnalizer( fSubQueryList[i] ).Free;
  fSubQueryList.Free;
  Inherited Destroy;
End;

{-------------------------------------------------------------------------------}
{                  Implement TColumnList                                        }
{-------------------------------------------------------------------------------}

Constructor TColumnList.Create;
Begin
  Inherited Create;
  fItems := TList.Create;
End;

Destructor TColumnList.Destroy;
Begin
  Clear;
  fItems.Free;
  Inherited Destroy;
End;

Function TColumnList.GetCount;
Begin
  Result := fItems.Count;
End;

Function TColumnList.GetItem( Index: Integer ): TColumnItem;
Begin
  Result := fItems[Index];
End;

Function TColumnList.Add: TColumnItem;
Begin
  Result := TColumnItem.Create( Self );
  fItems.Add( Result );
End;

Procedure TColumnList.Clear;
Var
  I: Integer;
Begin
  For I := 0 To fItems.Count - 1 Do
    TColumnItem( fItems[I] ).Free;
  fItems.Clear;
End;

Procedure TColumnList.Delete( Index: Integer );
Begin
  TColumnItem( fItems[Index] ).Free;
  fItems.Delete( Index );
End;

Procedure TColumnList.DeleteAggregate( RecNo: Integer );
Var
  I, J: Integer;
Begin
  For I := 0 To fItems.Count - 1 Do
    With TColumnItem( fItems[I] ) Do
      For J := 0 To AggregateList.Count - 1 Do
        AggregateList[J].SparseList.Delete( RecNo );
End;

Procedure TColumnList.SortAggregateWithList( SortList: TxqSortList );
Var
  I, J, K,
    Index: Integer;
  SparseList: TAggSparseList;
Begin
  For I := 0 To fItems.Count - 1 Do
    With TColumnItem( fItems[I] ) Do
      For J := 0 To AggregateList.Count - 1 Do
      Begin
        { if this columns contains aggregate functions, the value for every
          record is saved on TColumnItem(fItems[I]).AggregateList[J].SparseList.Values[Index]
          where J is the No. of aggregate (several aggregates accepted on every column)
          and Index is the number of record on the result set}
        SparseList := TAggSparseList.Create( 1000 );
        For K := 1 To SortList.Count Do
        Begin
          SortList.Recno := K;
          Index := SortList.SourceRecno;
          If AggregateList[J].SparseList.HasData(Index) Then
          Begin
            SparseList.Values[K] := AggregateList[J].SparseList.Values[Index];
            SparseList.Count[K] := AggregateList[J].SparseList.Count[Index];
          End;
        End;
        AggregateList[J].SparseList.Free;
        AggregateList[J].SparseList := SparseList;
      End;
End;