ffxquery.pas

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

      Alias := Item.Alias;
      IniFile.writeString( 'General', 'Alias' + IntToStr( I + 1 ), Alias );
    End;
  Finally
    IniFile.Free;
  End;
End;

Procedure TDataList.OpenDataSets;
Var
  I: Integer;
Begin
  Screen.Cursor := crHourglass;
  Try
    For I := 0 To FItems.Count - 1 Do
      TDataItem( FItems[I] ).Open;
  Finally
    Screen.Cursor := crDefault;
  End;
End;

Procedure TDataList.CloseDataSets;
Var
  I: Integer;
Begin
  For I := 0 To FItems.Count - 1 Do
    TDataItem( FItems[I] ).DataSet.Close;
End;

{ Startt of TFFxQuery implementation }

Function filterL( line, from_ch, to_ch: String ): String;
Var
  posn,
    locn: integer;
Begin
  posn := 1;
  While posn <= length( line ) Do
  Begin
    locn := pos( line[posn], from_ch );
    If locn = 0 Then
      inc( posn )
    Else If locn > length( to_ch ) Then
      delete( line, posn, 1 )
    Else
    Begin
      line[posn] := to_ch[locn];
      inc( posn );
    End;
  End;
  result := line;
End;

Function extractL( line: String; sep: char; locn: integer ): String;
Var
  cntr,
    spos,
    posn: integer;
Begin
  spos := 1;
  For cntr := 1 To locn - 1 Do
  Begin
    posn := pos( sep, copy( line, spos, $FFFF ) );
    If posn = 0 Then
      spos := $FFFF
    Else
      inc( spos, posn );
  End;
  posn := pos( sep, copy( line, spos, $FFFF ) );
  If posn = 0 Then
    posn := $FFFF;
  result := copy( line, spos, posn - 1 );
End;

Constructor TFFxQuery.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  fIndexList[1] := TStringList.Create;
  fIndexList[2] := TStringList.Create;
  DataSets.DataSetClass := TffTable; // don't accept other datasets
End;

Destructor TFFxQuery.Destroy;
Begin
  fIndexList[1].Free;
  fIndexList[2].Free;
  Inherited Destroy;
End;

Procedure TFFxQuery.Loaded;
Begin
  Inherited Loaded;
  OnIndexNeededFor := IndexNeededFor;
  OnSetRange := SetRange;
  OnCancelRange := CancelRange;
  OnSetUserRange := SetUserRange;
  OnCancelUserRange := CancelUserRange;
  OnCreateTable := CreateTable;
  OnCreateIndex := CreateIndex;
  OnDropTable := DropTable;
  OnDropIndex := DropIndex;
  FOldBeforeQuery := OnBeforeQuery;
  FOldAfterQuery := OnAfterQuery;
  OnBeforeQuery := BeforeQuery;
  OnAfterQuery := AfterQuery;
End;

Procedure TFFxQuery.IndexNeededFor( Sender: TObject;
  DataSet: TDataSet; Const FieldNames: String; ActivateIndex: Boolean;
  IsJoining: Boolean; Var Accept: Boolean );
Var
  fcntr,
    xcntr,
    cntr: integer;
  fNames,
    xNames: String;
Begin
  If IsJoining Then
    Exit;
  Accept := False;
  If Not ( WhereOptimizeMethod = omSetRange ) Then
    exit;

  fNames := AnsiUpperCase( FieldNames );
  fcntr := 1;
  For cntr := 1 To length( fNames ) Do
    If fNames[cntr] = ';' Then
      inc( fcntr );
  With TffTable( DataSet ) Do
  Begin
    If IndexDefs.Count = 0 Then
      IndexDefs.Update;
    For xcntr := fcntr Downto 1 Do
    Begin
      For cntr := 0 To IndexDefs.Count - 1 Do
      Begin
        xNames := AnsiUpperCase( TIndexDef( IndexDefs[cntr] ).Fields );
        If fNames + ';' = copy( xNames + ';', 1, length( fNames ) + 1 ) Then
        Begin
          Accept := True;
          If fIndexList[1].IndexOf( DataSet.Name + '|' + FieldNames ) = -1 Then
          Begin
            fIndexList[1].Add( DataSet.Name + '|' + FieldNames );
            fIndexList[2].Add( filterL( IntToStr( xcntr ) + ';' + fNames, ';', #13 ) );
          End;
          IndexFieldNames := fNames;
          break;
        End;
      End;
      If Accept Then
        break;
      If fcntr <> 1 Then
      Begin
        For cntr := length( fNames ) Downto 1 Do
        Begin
          If fNames[cntr] = ';' Then
          Begin
            fNames := copy( fNames, 1, cntr - 1 );
            break;
          End;
        End;
      End;
    End;
  End;
End;

Procedure TFFxQuery.SetRange( Sender: TObject; RelOperator: TRelationalOperator;
  DataSet: TDataSet; Const FieldNames, StartValues, EndValues: String; IsJoining: Boolean );
Var
  ix: integer;
  fc: integer;
  fNames: TStringList;

  Procedure LoadRangeValues( Const rvals: String );
  Var
    cntr: integer;
    valstr: String;
  Begin
    For cntr := 1 To fc Do
    Begin
      valstr := extractL( rvals, ';', cntr );
      Try
        TffTable( DataSet ).FieldByName( fNames[cntr] ).Value := valstr;
      Except
        TffTable( DataSet ).FieldByName( fNames[cntr] ).Value := StrToFloat( valstr );
      End;
    End;
  End;

Begin
  ix := fIndexList[1].IndexOf( DataSet.Name + '|' + FieldNames );
  If ix <> -1 Then
  Begin
    fNames := TStringList.Create;
    fNames.Text := fIndexList[2][ix];
    With TffTable( DataSet ) Do
    Begin
      fc := StrToInt( fNames[0] );
      SetRangeStart;
      KeyFieldCount := fc;
      If RelOperator In [ropBETWEEN, ropGT, ropGE] Then
        LoadRangeValues( StartValues );
      SetRangeEnd;
      KeyFieldCount := fc;
      If RelOperator In [ropBETWEEN, ropLT, ropLE] Then
        LoadRangeValues( EndValues );
      ApplyRange;
    End;
    fNames.Free;
  End;
End;

Procedure TFFxQuery.CancelRange( Sender: TObject; DataSet: TDataSet; IsJoining: Boolean );
Begin
  TffTable( DataSet ).CancelRange;
End;

{ end-user defined ranges}

Procedure TFFxQuery.SetUserRange( Sender: TObject; Dataset: TDataset;
  Const UsingIndex: String;
  ForFields, StartValues, EndValues: TStrings );
Var
  I: Integer;
Begin
  With TffTable( Dataset ) Do
  Begin
    IndexName := UsingIndex;

    SetRangeStart;

    KeyFieldCount := StartValues.Count;
    For I := 0 To ForFields.Count - 1 Do
      FieldByName( ForFields[I] ).AsString := StartValues[I];

    SetRangeEnd;

    KeyFieldCount := EndValues.Count;
    For I := 0 To ForFields.Count - 1 Do
      FieldByName( ForFields[I] ).AsString := EndValues[I];

    ApplyRange;
  End;
End;

Procedure TFFxQuery.CancelUserRange( Sender: TObject; Dataset: TDataset );
Begin
  TffTable( DataSet ).CancelRange;
End;

Procedure TFFxQuery.CreateTable( Sender: TObject; CreateTable: TCreateTableItem );
Begin
End;

Procedure TFFxQuery.CreateIndex( Sender: TObject; Unique, Descending: Boolean;
  Const TableName, IndexName: String; ColumnExprList: TStringList );
Begin
End;

Procedure TFFxQuery.DropTable( Sender: TObject; Const TableName: String );
Begin
End;

Procedure TFFxQuery.DropIndex( Sender: TObject; Const TableName, IndexName: String );
Begin
End;

Procedure TFFxQuery.SetDataList( Value: TDataList );
Var
  I: Integer;
Begin
  DataSets.Clear;
  If Not Assigned( Value ) Then
    Exit;
  { feed the datasets from the data list }
  For I := 0 To Value.Count - 1 Do
    AddDataSet( Value[I].DataSet, Value[I].Alias );

  FDataList := Value;
End;

Procedure TFFxQuery.BeforeQuery( Sender: TObject );
Begin
  If Not ( WhereOptimizeMethod = omSetRange ) Then
  Begin
    FSaveIndexNeededFor := OnIndexNeededfor;
    FSaveSetRange := OnSetRange;
    FSaveCancelRange := OnCancelRange;
    FSaveSetFilter := OnSetFilter;
    FSaveCancelFilter := OnCancelFilter;

    OnIndexNeededfor := Nil;
    OnSetRange := Nil;
    OnCancelRange := Nil;
    OnSetFilter := Nil;
    OnCancelFilter := Nil;
  End;
  If Assigned( FOldBeforeQuery ) Then
    FOldBeforeQuery( Self );
End;

Procedure TFFxQuery.AfterQuery( Sender: TObject );
Begin
  If Not ( WhereOptimizeMethod = omSetRange ) Then
  Begin
    OnIndexNeededfor := FSaveIndexNeededFor;
    OnSetRange := FSaveSetRange;
    OnCancelRange := FSaveCancelRange;
    OnSetFilter := FSaveSetFilter;
    OnCancelFilter := FSaveCancelFilter;
  End;
  If Assigned( FOldAfterQuery ) Then
    FOldAfterQuery( Self );
End;

End.