halcnqry.pas

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

      If sStr[iLen] > #0 Then
        sStr := Copy( sStr, 1, iLen - 1 ) + Char( Ord( sStr[iLen] ) - 1 ) // Minus one
      Else
        sStr := Copy( sStr, 1, iLen - 1 ); // Chop off last Char
    End;
    Result := sStr;
  End; //--------------------------------------------------------------------//

  // IncStr - Increments a string value (ex. 'Hello' -> 'Hellp')-------------//
  Function IncStr( sStr: String ): String;
  Var
    iLen: Integer;
  Begin
    iLen := Length( sStr );
    If iLen > 0 Then
    Begin
      If sStr[iLen] < #255 Then
        sStr := Copy( sStr, 1, iLen - 1 ) + Char( Ord( sStr[iLen] ) + 1 ) // Add one
      Else
        sStr := sStr + #1; // Add one character
    End;
    Result := sStr;
  End; //--------------------------------------------------------------------//

Begin
  With THalcyonDataset( DataSet ) Do
  Begin
    Case RelOperator Of
      ropBETWEEN: SetRange( StartValues, endValues );
      ropGT: SetRange( IncStr( StartValues ), #255 );
      ropGE: SetRange( StartValues, #255 );
      ropLT: SetRange( #0, DecStr( endValues ) );
      ropLE: SetRange( #0, endValues );
      ropNEQ: ; // how?
    End;
  End;
End;

Procedure THalcyonxQuery.CancelRange( Sender: TObject; DataSet: TDataSet;
  IsJoining: Boolean );
Begin
  ( DataSet As THalcyonDataSet ).SetRange( '', '' );
  ( DataSet As THalcyonDataSet ).Filtered := False;
End;

Procedure THalcyonxQuery.CreateTable( Sender: TObject; CreateTable: TCreateTableItem );
Var
  FieldList: TStringList;
  s,
    FileName,
    FieldName,
    IndexFileName: String;
  FieldType: Char;
  I,
    FieldSize,
    FieldDec: Integer;
  Halc: THalcyonDataSet;
  IndexFiles: TStringList;
Begin
  { if not datalist is assigned then I cannot save to a global configuration file }
  If Not Assigned( FDataList ) Then
    Exit;

  FileName := CreateTable.TableName;
  If FileExists( FileName ) And Not FAutoOver Then
  Begin
    If Application.MessageBox( PChar( hqErrOverwriteTable ), 'Warning', MB_OKCANCEL ) = IDCANCEL Then
      Exit;
  End;
  FieldList := TStringList.Create;
  IndexFiles := TStringList.Create;
  Try
    For I := 0 To CreateTable.FieldCount - 1 Do
    Begin
      FieldName := CreateTable.Fields[I].FieldName;
      Case CreateTable.Fields[I].FieldType Of
        // list of possible types accepted in TxQuery parser
        RW_CHAR:
          Begin
            FieldType := 'C';
            FieldSize := CreateTable.Fields[I].Size;
            FieldDec := 0;
          End;
        RW_INTEGER, RW_AUTOINC:
          Begin
            FieldType := 'N';
            FieldSize := 11;
            FieldDec := 0;
          End;
        RW_SMALLINT:
          Begin
            FieldType := 'N';
            FieldSize := 6;
            FieldDec := 0;
          End;
        RW_BOOLEAN:
          Begin
            FieldType := 'L';
            FieldSize := 1;
            FieldDec := 0;
          End;
        RW_DATE, RW_TIME, RW_DATETIME:
          Begin
            FieldType := 'D';
            FieldSize := 10;
            FieldDec := 0;
          End;
        RW_MONEY, RW_FLOAT:
          Begin
            FieldType := 'N';
            If CreateTable.Fields[I].Scale = 0 Then
            Begin
              FieldSize := 20;
              FieldDec := 4;
            End
            Else
            Begin
              FieldSize := CreateTable.Fields[I].Scale;
              FieldDec := CreateTable.Fields[I].Precision;
            End;
          End;
        RW_BLOB:
          Begin
            // use BlobType property here
            Case CreateTable.Fields[I].BlobType Of
              1, 3: // Memo, formatted Memo
                FieldType := 'M';
              2, 4: // Binary, OLE
                FieldType := 'B';
              5: // Graphic/Binary
                FieldType := 'G';
            End;
            FieldSize := 8;
            FieldDec := 0;
          End;
      End;
      FieldList.Add( format( '%s;%s;%d;%d', [FieldName, FieldType, FieldSize, FieldDec] ) );
    End;
    gs6_shel.CreateDBF( FileName, '', FType, FieldList );
    Halc := THalcyonDataSet.Create( Nil );
    Halc.DatabaseName := AddSlash( ExtractFilePath( FileName ) );
    Halc.TableName := ExtractFileName( FileName );
    Try
      Halc.Open;
    Except
      Halc.Free;
      Raise;
    End;
    { add the new created table to the list of datasets
    Self.AddDataSet(Halc, ChangeFileExt(Halc.TableName,''));}
    If CreateTable.PrimaryKey.Count > 0 Then
    Begin
      S := CreateTable.PrimaryKey[0];
      For I := 1 To CreateTable.PrimaryKey.Count - 1 Do
        S := S + '+' + CreateTable.PrimaryKey[I];
      IndexFileName := ChangeFileExt( FileName, IDXExtns[Ord( FType )] );
      Halc.IndexOn( IndexFileName, 'PRIMARY', S, '.NOT.DELETED()', // optional
        Halcn6DB.Unique, Halcn6DB.Ascending );
      IndexFiles.Add( IndexFileName );
    End;
    { add to the list }
    FDataList.Add( FileName, ChangeFileExt( Halc.TableName, '' ), IndexFiles );
    FDataList.SaveToFile( FDataList.ConfigFileName );
  Finally
    FieldList.Free;
    IndexFiles.Free;
  End;
End;

Procedure THalcyonxQuery.CreateIndex( Sender: TObject; Unique, Descending: Boolean;
  Const TableName, IndexName: String; ColumnExprList: TStringList );
Var
  Temps: String;
  j, Index: integer;
  IndexUnique: TgsIndexUnique;
  SortStatus: TgsSortStatus;
  Halc: THalcyonDataSet;
Begin
  If Not Assigned( FDataList ) Then
    Exit;

  Index := FDataList.IndexOf( TableName );
  If Index < 0 Then
    Exit;
  Temps := ColumnExprList[0];
  For j := 1 To ColumnExprList.Count - 1 Do
    Temps := Temps + '+' + ColumnExprList[j];
  If Unique Then
    IndexUnique := Halcn6DB.Unique
  Else
    IndexUnique := Halcn6DB.Duplicates;
  If Descending Then
    SortStatus := Halcn6DB.Descending
  Else
    SortStatus := Halcn6DB.Ascending;
  Halc := FDataList[Index].DataSet As THalcyonDataSet;
  { supposed to add to a primary index .cdx, .mdx }
  Halc.IndexOn( ChangeFileExt( Halc.TableName, IDXExtns[Ord( FType )] ),
    IndexName, Temps, '.NOT.DELETED()', // optional
    IndexUnique, SortStatus );
  FDataList.SaveToFile( FDataList.ConfigFileName );
End;

Procedure THalcyonxQuery.DropTable( Sender: TObject; Const TableName: String );
Var
  Index: integer;
Begin
  If Not Assigned( FDataList ) Then
    Exit;

  Index := FDataList.IndexOf( TableName );
  If Index < 0 Then
    Exit;
  SysUtils.DeleteFile( TableName );
  FDataList.Delete( Index );
End;

Procedure THalcyonxQuery.DropIndex( Sender: TObject; Const TableName, IndexName: String );
Var
  Halc: THalcyonDataSet;
  Index: integer;
Begin
  If Not Assigned( FDataList ) Then
    Exit;

  Index := FDataList.IndexOf( TableName );
  If Index < 0 Then
    Exit;
  Halc := FDataList[Index].DataSet As THalcyonDataSet;
  If Halc.Active Then
    Halc.IndexTagRemove( ChangeFileExt( Halc.TableName, IDXExtns[Ord( FType )] ), IndexName );
End;

Procedure THalcyonxQuery.SaveToDBF( Const FileName: String );
Var
  I: Integer;
  Field, SrcField, DestField: TField;
  FieldList, NewFieldNamesList: TStringList;
  FieldName: String;
  FieldType: Char;
  FieldSize, FieldDec: Integer;
  Halc: THalcyonDataSet;
  bm: TBookmark;

  Function CheckDuplicate( Const fname: String ): String;
  Var
    NumTry: Integer;
    Found: Boolean;
  Begin
    Result := fname;
    NumTry := 0;
    Repeat
      Found := NewFieldNamesList.IndexOf( Result ) >= 0;
      If Found Then
      Begin
        Inc( NumTry );
        Result := Copy( fname, 1, 8 ) + '_' + IntToStr( NumTry );
      End;
    Until Not Found;
  End;

Begin
  If FileExists( FileName ) And Not FAutoOver Then
  Begin
    If Application.MessageBox( PChar( hqErrOverwriteTable ), 'Warning', MB_OKCANCEL ) = IDCANCEL Then
      exit;
  End;
  FieldList := TStringList.Create;
  NewFieldNamesList := TStringList.Create;
  Halc := THalcyonDataSet.Create( Nil );
  Halc.DatabaseName := AddSlash( ExtractFilePath( FileName ) );
  Halc.TableName := ExtractFileName( FileName );
  DisableControls;
  bm := GetBookmark;
  Try
    For I := 0 To Self.FieldCount - 1 Do
    Begin
      Field := Self.Fields[I];
      // warning: SQL statement must have a valid DBF file name in as AS clause
      // this is not valid: SELECT CustNo As VeryLongFieldName FROM Customer
      // due to that DBF only accepts field names of 10 chars max length
      FieldName := Field.FieldName;
      ReplaceString( FieldName, ' ', '' );
      FieldName := CheckDuplicate( Copy( FieldName, 1, 10 ) );
      NewFieldNamesList.Add( FieldName );
      Case Field.DataType Of
        ftMemo, ftFmtMemo:
          Begin
            FieldType := 'M';
            FieldSize := 8;
            FieldDec := 0;
          End;
        ftGraphic:
          Begin
            FieldType := 'G';
            FieldSize := 8;
            FieldDec := 0;
          End;
        ftBytes, ftvarBytes, ftBlob,
          ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor
{$IFDEF LEVEL4}, ftADT, ftArray, ftReference, ftDataSet{$ENDIF}:
          Begin
            FieldType := 'B';
            FieldSize := 8;
            FieldDec := 0;
          End;
        ftString{$IFDEF LEVEL4}, ftFixedChar, ftWideString{$ENDIF}{$IFDEF LEVEL5}, ftGUID{$ENDIF}:
          Begin
            FieldType := 'C';
            FieldSize := ResultSet.Fields[I].ColWidth;
            FieldDec := 0;
          End;
        ftFloat, ftCurrency, ftBCD:
          Begin
            FieldType := 'N';
            FieldSize := 20; // you can change this
            FieldDec := 4;
          End;
        ftDate, ftTime, ftDateTime:
          Begin
            FieldType := 'D';
            FieldSize := 10;
            FieldDec := 0;
          End;
        ftAutoInc, ftSmallInt, ftInteger, ftWord
{$IFNDEF LEVEL3}, ftLargeInt{$ENDIF}:
          Begin
            FieldType := 'N';
            FieldSize := 11; // configure this also to your needs
            FieldDec := 0;
          End;
        ftBoolean:
          Begin
            FieldType := 'L';
            FieldSize := 1;
            FieldDec := 0;
          End;
      End;
      FieldList.Add( format( '%s;%s;%d;%d', [FieldName, FieldType, FieldSize, FieldDec] ) );
    End;
    gs6_shel.CreateDBF( FileName, '', FoxPro2, FieldList ); // change FoxPro2 to your choice
    Halc.Open;
    // after creating dbf, insert records from source DBF to dest DBF
    Self.First;
    While Not Self.EOF Do
    Begin
      Halc.Insert;
      For I := 0 To Self.FieldCount - 1 Do
      Begin
        SrcField := Self.Fields[I];
        DestField := Halc.Fields[I];
        DestField.Assign( SrcField );
      End;
      Halc.Post;

      Self.Next;
    End;
  Finally
    If Bookmarkvalid( bm ) Then
      GotoBookmark( bm );
    FreeBookmark( bm );
    EnableControls;
    FieldList.Free;
    NewFieldNamesList.Free;
    Halc.Free;
  End;
End;

Procedure THalcyonxQuery.BeforeQuery( Sender: TObject );
Var
  I: Integer;
Begin
  //if WhereOptimizeMethod<>omSetFilter then
  //begin
  FSaveIndexNeededFor := OnIndexNeededfor;
  FSaveSetRange := OnSetRange;
  FSaveCancelRange := OnCancelRange;
  FSaveSetFilter := OnSetFilter;
  FSaveCancelFilter := OnCancelFilter;

  OnIndexNeededfor := IndexNeededFor;
  OnSetRange := SetRange;
  OnCancelRange := CancelRange;
  OnSetFilter := SetFilter;
  OnCancelFilter := CancelFilter;
  //end;
  For I := 0 To DataSets.Count - 1 Do
  Begin
    With ( DataSets[I].DataSet As THalcyonDataSet ) Do
    Begin
      FSaveUseDeleted[I] := UseDeleted;
      UseDeleted := Self.FUseDeleted;
    End;
  End;
End;

Procedure THalcyonxQuery.AfterQuery( Sender: TObject );
Var
  I: Integer;
Begin
  //if WhereOptimizeMethod<>omSetFilter then
  //begin
  OnIndexNeededfor := FSaveIndexNeededFor;
  OnSetRange := FSaveSetRange;
  OnCancelRange := FSaveCancelRange;
  OnSetFilter := FSaveSetFilter;
  OnCancelFilter := FSaveCancelFilter;
  //end;
  For I := 0 To DataSets.Count - 1 Do
  Begin
    With ( DataSets[I].DataSet As THalcyonDataSet ) Do
      { restore previous states of the dataset }
      UseDeleted := FSaveUseDeleted[I];
  End;
End;

Procedure THalcyonxQuery.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 );
  UseDeleted := Value.UseDeleted;

  FDataList := Value;
End;

Procedure THalcyonxQuery.FixDummiesForFilter( Var Filter: String );
Var
  Ps: Integer;
  I: Integer;
  Dt: Double;
Begin
  { this method called in the WHERE clause is a filter in
    order to fix some flags:
    - working flag now is the date in the format: 'DummyDate(32445.6566)'
    - another is the handling of True and False in the expression parser }
  ReplaceString( Filter, 'DummyBoolean(True)', 'True' );
  ReplaceString( Filter, 'DummyBoolean(False)', 'False' );
  Ps := AnsiPos( 'DummyDate(', Filter );
  While Ps > 0 Do
  Begin
    If Ps > 0 Then
    Begin
      { by default, the date is left as it is but in descendant classes
        the date can be changed to meet the dataset filter implementation}
      For I := Ps + 1 To Length( Filter ) Do
        If Filter[I] = ')' Then
        Begin
          Dt := StrToFloat( Copy( Filter, Ps + 10, I - ( Ps + 10 ) ) );
          ReplaceString( Filter, Copy( Filter, Ps, ( I - Ps ) + 1 ), '{' + DateToStr( Dt ) + '}' );
          Break;
        End;
    End;
    Ps := AnsiPos( 'DummyDate(', Filter );
  End;
End;

Procedure THalcyonxQuery.SetFilter( Sender: TObject; DataSet: TDataset; Const Filter: String;
  IsJoining: Boolean; Var Handled: Boolean );
Var
  Halcn: THalcyonDataset;
Begin
  { this is only called for the WHERE expression }
  Try
    Halcn := Dataset As THalcyonDataset;
    Halcn.Filtered := False;
    Halcn.Filter := Filter;
    Halcn.Filtered := True;
    Handled := True;
  Except
    Handled := False;
    ( DataSet As THalcyonDataSet ).Filtered := False;
  End;
End;

Procedure THalcyonxQuery.CancelFilter( Sender: TObject; DataSet: TDataSet;
  IsJoining: Boolean );
Begin
  With ( DataSet As THalcyonDataset ) Do
  Begin
    Filtered := False;
    Filter := '';
  End;
End;

End.