xqbase.pas

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

{-------------------------------------------------------------------------------}

Constructor TInsertItem.Create( InsertList: TInsertList );
Begin
  Inherited Create;
  fInsertList := InsertList;
  fFieldNames := TStringList.Create;
  fExprList := TStringList.Create;
  fResolverList := TList.Create;
End;

Destructor TInsertItem.Destroy;
Var
  I: Integer;
  Resolver: TExprParser;
Begin
  fFieldNames.Free;
  fExprList.Free;
  For I := 0 To fResolverList.Count - 1 Do
  Begin
    Resolver := TExprParser( fResolverList[I] );
    If Assigned( Resolver ) Then
      Resolver.Free;
  End;
  fResolverList.Free;
  Inherited Destroy;
End;

{-------------------------------------------------------------------------------}
{                  Implement TInsertList                                        }
{-------------------------------------------------------------------------------}

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

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

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

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

Function TInsertList.Add: TInsertItem;
Begin
  Result := TInsertItem.Create( Self );
  fItems.Add( Result );
End;

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

Procedure TInsertList.Delete( Index: Integer );
Begin
  TInsertItem( fItems[Index] ).Free;
  fItems.Delete( Index );
End;

{-------------------------------------------------------------------------------}
{                  implements TSrtField                                         }
{-------------------------------------------------------------------------------}

Constructor TSrtField.Create( Fields: TSrtFields );
Begin
  Inherited Create;
  fFields := Fields;
End;

Function TSrtField.GetData( Buffer: Pointer ): Boolean;
Begin
  Result := fFields.fSortList.GetFieldData( Self, Buffer );
End;

Procedure TSrtField.SetData( Buffer: Pointer );
Begin
  fFields.fSortList.SetFieldData( Self, Buffer );
End;

Procedure TSrtField.SetDataType( Value: TExprType );
Begin
  fDataType := Value;
End;

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

Constructor TSrtStringField.Create( Fields: TSrtFields );
Begin
  Inherited Create( Fields );
  SetDataType( ttString );
End;

Function TSrtStringField.GetValue( Var Value: String ): Boolean;
Var
  Buffer: Array[0..dsMaxStringSize] Of Char;
Begin
  Result := GetData( @Buffer );
  If Result Then
    Value := Buffer;
End;

Function TSrtStringField.GetAsString: String;
Begin
  If Not GetValue( Result ) Then
    Result := '';
End;

Procedure TSrtStringField.SetAsString( Const Value: String );
Var
  Buffer: Array[0..dsMaxStringSize] Of Char;
  L: Integer;
Begin
  FillChar( Buffer, fDataSize, 0 );
  L := Length( Value );
  StrLCopy( Buffer, PChar( Value ), L );
  SetData( @Buffer );
End;

Function TSrtStringField.GetAsFloat: double;
Begin
  Result := 0;
End;

Procedure TSrtStringField.SetAsFloat( Value: double );
Begin
End;

Function TSrtStringField.GetAsInteger: Longint;
Begin
  Result := 0;
End;

Procedure TSrtStringField.SetAsInteger( Value: Longint );
Begin
End;

Function TSrtStringField.GetAsBoolean: Boolean;
Begin
  Result := False;
End;

Procedure TSrtStringField.SetAsBoolean( Value: Boolean );
Begin
End;

{-------------------------------------------------------------------------------}
{                  implements TSrtFloatField                                        }
{-------------------------------------------------------------------------------}

Constructor TSrtFloatField.Create( Fields: TSrtFields );
Begin
  Inherited Create( Fields );
  SetDataType( ttFloat );
End;

Function TSrtFloatField.GetAsFloat: double;
Begin
  If Not GetData( @Result ) Then
    Result := 0;
End;

Procedure TSrtFloatField.SetAsFloat( Value: double );
Begin
  SetData( @Value );
End;

Function TSrtFloatField.GetAsString: String;
Var
  F: Double;
Begin
  If GetData( @F ) Then
    Result := FloatToStr( F )
  Else
    Result := '';
End;

Procedure TSrtFloatField.SetAsString( Const Value: String );
Var
  F: Extended;
Begin
  If Value = '' Then
    SetAsFloat( 0 )
  Else
  Begin
    If Not TextToFloat( PChar( Value ), F, fvExtended ) Then
      EXQueryError.CreateFmt( SIsInvalidFloatValue, [Value] );
    SetAsFloat( F );
  End;
End;

Function TSrtFloatField.GetAsInteger: Longint;
Begin
  Result := 0;
End;

Procedure TSrtFloatField.SetAsInteger( Value: Longint );
Begin
End;

Function TSrtFloatField.GetAsBoolean: Boolean;
Begin
  Result := False;
End;

Procedure TSrtFloatField.SetAsBoolean( Value: Boolean );
Begin
End;

{-------------------------------------------------------------------------------}
{                  implements TsrtIntegerField                                      }
{-------------------------------------------------------------------------------}

Constructor TSrtIntegerField.Create( Fields: TSrtFields );
Begin
  Inherited Create( Fields );
  SetDataType( ttInteger );
End;

Function TSrtIntegerField.GetAsInteger: Longint;
Begin
  If Not GetData( @Result ) Then
    Result := 0;
End;

Procedure TSrtIntegerField.SetAsInteger( Value: Longint );
Begin
  SetData( @Value );
End;

Function TSrtIntegerField.GetAsString: String;
Var
  L: Longint;
Begin
  If GetData( @L ) Then
    Str( L, Result )
  Else
    Result := '';
End;

Procedure TSrtIntegerField.SetAsString( Const Value: String );
Var
  E: Integer;
  L: Longint;
Begin
  Val( Value, L, E );
  If E <> 0 Then
    EXQueryError.CreateFmt( SIsInvalidIntegerValue, [Value] );
  SetAsInteger( L );
End;

Function TSrtIntegerField.GetAsFloat: double;
Begin
  Result := 0;
End;

Procedure TSrtIntegerField.SetAsFloat( Value: double );
Begin
End;

Function TSrtIntegerField.GetAsBoolean: Boolean;
Begin
  Result := False;
End;

Procedure TSrtIntegerField.SetAsBoolean( Value: Boolean );
Begin
End;

{-------------------------------------------------------------------------------}
{                  implements TSrtBooleanField                                      }
{-------------------------------------------------------------------------------}

Constructor TSrtBooleanField.Create( Fields: TSrtFields );
Begin
  Inherited Create( Fields );
  SetDataType( ttBoolean );
End;

Function TSrtBooleanField.GetAsBoolean: Boolean;
Var
  B: WordBool;
Begin
  If GetData( @B ) Then
    Result := B
  Else
    Result := False;
End;

Procedure TSrtBooleanField.SetAsBoolean( Value: Boolean );
Var
  B: WordBool;
Begin
  If Value Then
    Word( B ) := 1
  Else
    Word( B ) := 0;
  SetData( @B );
End;

Function TSrtBooleanField.GetAsString: String;
Var
  B: WordBool;
Begin
  If GetData( @B ) Then
    Result := Copy( xqbase.NBoolean[B], 1, 1 )
  Else
    Result := '';
End;

Procedure TSrtBooleanField.SetAsString( Const Value: String );
Var
  L: Integer;
Begin
  L := Length( Value );
  If L = 0 Then
  Begin
    SetAsBoolean( False );
  End
  Else
  Begin
    If AnsiCompareText( Value, Copy( xqbase.NBoolean[False], 1, L ) ) = 0 Then
      SetAsBoolean( False )
    Else If AnsiCompareText( Value, Copy( xqbase.NBoolean[True], 1, L ) ) = 0 Then
      SetAsBoolean( True )
    Else
      EXQueryError.CreateFmt( SIsInvalidBoolValue, [Value] );
  End;
End;

Function TSrtBooleanField.GetAsInteger: Longint;
Begin
  Result := 0;
End;

Procedure TSrtBooleanField.SetAsInteger( Value: Longint );
Begin
End;

Function TSrtBooleanField.GetAsFloat: double;
Begin
  Result := 0;
End;

Procedure TSrtBooleanField.SetAsFloat( Value: double );
Begin
End;

{-------------------------------------------------------------------------------}
{                  implements TSrtFields                                            }
{-------------------------------------------------------------------------------}

Constructor TSrtFields.Create( SortList: TxqSortList );
Begin
  Inherited Create;
  fSortList := SortList;
  fItems := TList.Create;
End;

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

Function TSrtFields.GetCount: Integer;
Begin
  Result := fItems.Count;
End;

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

Function TSrtFields.Add( DataType: TExprType ): TSrtField;
Begin
  Result := Nil;
  Case DataType Of
    ttString: Result := TSrtStringField.Create( Self );
    ttFloat: Result := TSrtFloatField.Create( Self );
    ttInteger: Result := TSrtIntegerField.Create( Self );
    ttBoolean: Result := TSrtBooleanField.Create( Self );
  End;
  fItems.Add( Result );
End;

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

{-------------------------------------------------------------------------------}
{                  Define TxqSortList                                           }
{-------------------------------------------------------------------------------}

Constructor TxqSortList.Create( UsingBookmark: Boolean );
Begin
  Inherited Create;
  fFields := TSrtFields.Create( Self );
  fRecNo := -1;
  fRecordBufferSize := SizeOf( Integer ); { first data is the SourceRecNo property }
  fUsingBookmark := UsingBookmark;
End;

Destructor TxqSortList.Destroy;
Var
  I: Integer;
Begin
  If fUsingBookmark And Assigned( fBookmarkedDataset ) Then
  Begin
    For I := 1 To GetRecordCount Do
    Begin
      SetRecno( I );
      fBookmarkedDataset.FreeBookmark( TBookmark( SourceRecno ) );
    End;
  End;
  fFields.Free;
  If Assigned( FSelected ) Then
    FSelected.Free;
  Inherited Destroy;
End;

Procedure TxqSortList.SetRecno( Value: Integer );
Begin