halcnqry.pas

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

Unit HalcnQry;

{-------------------------------------------------------------------------------}
{   (C) 2002 Alfonso moreno                                                     }
{   THalcyonxQuery class implementation                                         }
{   You need Halcyon 6 in order to use this unit                                }
{-------------------------------------------------------------------------------}

{$I XQ_FLAG.INC}
Interface
//{$R HalcnQry.dcr}

Uses
  SysUtils, Windows, Messages, classes, Graphics, Controls, forms, Dialogs,
  StdCtrls, QBAseExpr, xqmiscel, xquery, halcn6DB, gs6_shel, Db, IniFiles,
  xqbase;

Type
  {-------------------------------------------------------------------------------}
  {                  forward declarations                                         }
  {-------------------------------------------------------------------------------}
  TDataList = Class;
  THalcyonxQuery = Class;

  {-------------------------------------------------------------------------------}
  {                  Defines TDataItem                                            }
  {-------------------------------------------------------------------------------}

  TDataItem = Class
  Private
    FDataList: TDataList; { belongs to                                          }
    FDataSet: TDataSet; { the THalcyonDataset                                 }
    FFileName: String; { the original filename c:\mydb\file1.dbf             }
    FAlias: String; { the alias assigned (to be passed to THalcyonxQuery) }
    FIndexFiles: TStringList; { The list of index files to use in FDataSet          }
  Public
    Constructor Create( DataList: TDataList );
    Destructor Destroy; Override;
    Procedure Open;

    Property FileName: String Read FFileName Write FFileName;
    Property Alias: String Read FAlias Write FAlias;
    Property DataSet: TDataSet Read FDataSet Write FDataSet;
    Property IndexFiles: TStringList Read FIndexFiles Write FIndexFiles;
  End;

  {-------------------------------------------------------------------------------}
  {                  Defines TDataList                                            }
  {-------------------------------------------------------------------------------}

  TDataList = Class
  Private
    FItems: TList;
    FUseDeleted: Boolean;
    FConfigFileName: String;
    FInMemResultSet: Boolean;
    FMapFileSize: Longint;
    FDateFormat: String;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): TDataItem;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Function Add( Const pFileName, pAlias: String; pIndexFiles: TStringList ): TDataItem;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Function IndexOf( Const S: String ): Integer;
    Procedure LoadFromFile( Const ConfigFileName: String );
    Procedure SaveToFile( Const ConfigFileName: String );
    Procedure OpenDataSets;
    Procedure CloseDataSets;

    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: TDataItem Read GetItem; Default;
    Property UseDeleted: Boolean Read FUseDeleted Write FUseDeleted;
    Property ConfigFileName: String Read FConfigFileName Write FConfigFileName;
    Property InMemResultSet: Boolean Read FInMemResultSet Write FInMemResultSet;
    Property MapFileSize: Longint Read FMapFileSize Write FMapFileSize;
    Property DateFormat: String Read FDateFormat Write FDateFormat;
  End;

  {-------------------------------------------------------------------------------}
  {                  Defines THalcyonxQuery                                       }
  {-------------------------------------------------------------------------------}

  THalcyonxQuery = Class( TCustomxQuery )
  Private
    FType: gsDBFTypes;
    FAutoOver: boolean;
    FUseDeleted: Boolean;
    FSaveUseDeleted: TBits;
    { this is only a reference to a global object and must not be created }
    FDataList: TDataList;
    // for temporary saving events
    FSaveIndexNeededFor: TIndexNeededForEvent;
    FSaveSetRange: TSetRangeEvent;
    FSaveCancelRange: TCancelRangeEvent;
    FSaveSetFilter: TSetFilterEvent;
    FSaveCancelFilter: TCancelFilterEvent;
    Procedure IndexNeededfor( Sender: TObject;
      DataSet: TDataset;
      Const FieldNames: String;
      ActivateIndex: Boolean;
      IsJoining: Boolean; Var Accept: Boolean );
    Procedure SetRange( Sender: TObject;
      RelOperator: TRelationalOperator;
      DataSet: TDataset;
      Const FieldNames, StartValues, EndValues: String;
      IsJoining: Boolean );
    Procedure CancelRange( Sender: TObject;
      DataSet: TDataset;
      IsJoining: Boolean );
  Protected
    Procedure FixDummiesForFilter( Var Filter: String ); Override;

    Procedure CreateTable( Sender: TObject; CreateTable: TCreateTableItem );
    Procedure CreateIndex( Sender: TObject; Unique, Descending: Boolean;
      Const TableName, IndexName: String; ColumnExprList: TStringList );
    Procedure DropTable( Sender: TObject; Const TableName: String );
    Procedure DropIndex( Sender: TObject; Const TableName, IndexName: String );
    Procedure BeforeQuery( Sender: TObject );
    Procedure AfterQuery( Sender: TObject );
    Procedure SetDataList( Value: TDataList );
    Procedure SetFilter( Sender: TObject; DataSet: TDataset; Const Filter: String;
      IsJoining: Boolean; Var Handled: Boolean );
    Procedure CancelFilter( Sender: TObject; DataSet: TDataset; IsJoining: Boolean );

  Public
    Constructor Create( AOwner: TComponent ); Override;
    Destructor Destroy; Override;

    Procedure SaveToDBF( Const FileName: String );
    Procedure Loaded; Override;

    Property DataList: TDataList Read FDataList Write SetDataList;
  Published
    { properties }
    Property DBFType: gsDBFTypes Read FType Write FType;
    Property AutoOverwrite: Boolean Read FAutoOver Write FAutoOver;

    Property UseDeleted: Boolean Read FUseDeleted Write FUseDeleted;

    { inherited properties }
    Property DataSets;
  End;

Procedure Register;

Implementation

Uses
  xqyacc;

Procedure Register;
Begin
  RegisterComponents( 'Halcyon6', [THalcyonxQuery] );
End;

Resourcestring
  hqErrOverwriteTable = 'Table exists.  Do you want to overwrite?';
  xqTablenameNotFound = 'Table name does not exists.';

Const
  IDXExtns: Array[0..3] Of String[4] = ( '.NTX', '.NDX', '.MDX', '.CDX' );

  {-------------------------------------------------------------------------------}
  {                  Implementes TDataItem                                        }
  {-------------------------------------------------------------------------------}

Constructor TDataItem.Create( DataList: TDataList );
Begin
  Inherited Create;
  FDataList := DataList;
  FIndexFiles := TStringList.Create;
  { the dataset belong to the DataList }
  FDataSet := THalcyonDataSet.Create( Nil );
End;

Destructor TDataItem.Destroy;
Begin
  FDataSet.Free;
  FIndexFiles.Free;
  Inherited Destroy;
End;

Procedure TDataItem.Open;
Begin
  FDataSet.Close;
  With ( FDataSet As THalcyonDataSet ) Do
  Begin
    DatabaseName := ExtractFilePath( FFileName );
    Tablename := ExtractFileName( FFileName );
    IndexFiles.Assign( Self.FIndexFiles );
    UseDeleted := FDataList.UseDeleted;
    Open;
  End;
End;

{-------------------------------------------------------------------------------}
{                  Implement TDataList                                          }
{-------------------------------------------------------------------------------}

Constructor TDataList.Create;
Begin
  Inherited Create;
  FItems := TList.Create;
End;

Destructor TDataList.Destroy;
Begin
  Clear;
  FItems.Free;
  Inherited Destroy;
End;

Function TDataList.IndexOf( Const S: String ): Integer;
Var
  I: Integer;
Begin
  result := -1;
  For I := 0 To FItems.Count - 1 Do
  Begin
    If AnsiCompareText( Items[I].FileName, S ) = 0 Then
    Begin
      Result := I;
      Exit;
    End;
  End;
End;

Function TDataList.GetCount;
Begin
  Result := FItems.Count;
End;

Function TDataList.GetItem( Index: Integer ): TDataItem;
Begin
  Result := FItems[Index];
End;

Function TDataList.Add( Const pFileName, pAlias: String; pIndexFiles: TStringList ): TDataItem;
Var
  I: Integer;
Begin
  Result := TDataItem.Create( Self );
  Try
    With TDataItem( Result ) Do
    Begin
      DataSet.Close;
      With THalcyonDataSet( DataSet ) Do
      Begin
        DatabaseName := ExtractFilePath( pFileName );
        TableName := ExtractFileName( pFileName );
        IndexFiles.Clear;
        For I := 0 To pIndexFiles.Count - 1 Do
          IndexFiles.Add( ExtractFileName( pIndexFiles[I] ) );
      End;
      IndexFiles.Assign( pIndexFiles );
      If Length( pAlias ) > 0 Then
        Alias := pAlias
      Else
        Alias := ChangeFileExt( ExtractFileName( pFileName ), '' );
      FileName := pFileName;
    End;
  Except
    Result.Free;
    Raise;
  End;
  FItems.Add( Result );
End;

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

Procedure TDataList.Delete( Index: Integer );
Begin
  TDataItem( FItems[Index] ).Free;
  FItems.Delete( Index );
End;

Procedure TDataList.LoadFromFile( Const ConfigFileName: String );
Var
  IniFile: TIniFile;
  NumFiles: Integer;
  NumIndexes: Integer;
  I: Integer;
  J: Integer;
  IndexFiles: TStringList;
  FileName: String;
  Alias: String;
Begin
  Clear;
  IniFile := TIniFile.Create( ConfigFileName );
  IndexFiles := TStringList.Create;
  Try
    { this is the configuration for the file :
    [General]
    NumFiles=3
    File1=C:\MyDatabase\File1.Dbf
    File2=C:\MyDatabase\File2.Dbf
    File3=C:\MyDatabase\File3.Dbf
    Alias1=Customer
    Alias2=Orders
    Alias3=Items
    ...
    UseDeleted=1 or 0
    FInMemResultSet : Boolean;
    FMapFileSize    : Longint;
    FDateFormat     : String;
    FUseDeleted     : Boolean;

    [File1]
    NumIndexes=1
    Index1=File1.Cdx
    }
    NumFiles := IniFile.ReadInteger( 'General', 'NumFiles', 0 );
    FUseDeleted := IniFile.ReadBool( 'General', 'UseDeleted', False );
    FInMemResultSet := IniFile.ReadBool( 'General', 'InMemResultSet', True );
    FMapFileSize := IniFile.ReadInteger( 'General', 'MapFileSize', 2000000 );
    FDateFormat := IniFile.ReadString( 'General', 'DateFormat', 'm/d/yyyy' );

    For I := 1 To NumFiles Do
    Begin
      IndexFiles.Clear;
      NumIndexes := IniFile.ReadInteger( 'File' + IntToStr( I ), 'NumIndexes', 0 );
      For J := 1 To NumIndexes Do
      Begin
        FileName := IniFile.ReadString( 'File' + IntToStr( I ), 'Index' + IntToStr( J ), '' );
        If Length( FileName ) > 0 Then
          IndexFiles.Add( FileName );
      End;
      FileName := IniFile.ReadString( 'General', 'File' + IntToStr( I ), '' );
      If Not FileExists( FileName ) Then
        Continue;
      Alias := IniFile.ReadString( 'General', 'Alias' + IntToStr( I ), '' );
      Add( FileName, Alias, IndexFiles );
    End;
  Finally
    IniFile.Free;
    IndexFiles.Free;
  End;
  FConfigFileName := ConfigFileName;
End;

Procedure TDataList.SaveToFile( Const ConfigFileName: String );
Var
  IniFile: TIniFile;
  NumFiles, NumIndexes, I, J: Integer;
  IndexFiles: TStringList;
  FileName, Alias: String;
  Item: TDataItem;
Begin
  IniFile := TIniFile.Create( ConfigFileName );
  IndexFiles := TStringList.Create;
  Try
    NumFiles := FItems.Count;
    IniFile.WriteInteger( 'General', 'NumFiles', NumFiles );
    IniFile.WriteBool( 'General', 'UseDeleted', FUseDeleted );
    IniFile.WriteBool( 'General', 'InMemResultSet', FInMemResultSet );
    IniFile.WriteInteger( 'General', 'MapFileSize', FMapFileSize );
    IniFile.WriteString( 'General', 'DateFormat', FDateFormat );
    For I := 0 To NumFiles - 1 Do
    Begin
      Item := Items[I];
      IndexFiles.Assign( THalcyonDataSet( Item.DataSet ).IndexFiles );
      NumIndexes := IndexFiles.Count;
      IniFile.WriteInteger( 'File' + IntToStr( I + 1 ), 'NumIndexes', NumIndexes );
      For J := 0 To IndexFiles.Count - 1 Do
      Begin
        FileName := IndexFiles[J];
        IniFile.writeString( 'File' + IntToStr( I + 1 ), 'Index' + IntToStr( J + 1 ), FileName );
      End;
      FileName := Item.FileName;
      IniFile.writeString( 'General', 'File' + IntToStr( I + 1 ), FileName );
      Alias := Item.Alias;
      IniFile.writeString( 'General', 'Alias' + IntToStr( I + 1 ), Alias );
    End;
  Finally
    IniFile.Free;
    IndexFiles.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;

{-------------------------------------------------------------------------------}
{                  Implementes THalcyonxQuery                                   }
{-------------------------------------------------------------------------------}

Constructor THalcyonxQuery.Create( AOwner: TComponent );
Begin
  Inherited Create( AOwner );
  //DataSets.DataSetClass   := THalcyonDataSet;
  AllSequenced := False;
  FSaveUseDeleted := TBits.Create;
  OnIndexNeededFor := IndexNeededFor;
  OnSetRange := SetRange;
  OnCancelRange := CancelRange;
End;

Destructor THalcyonxQuery.Destroy;
Begin
  FSaveUseDeleted.Free;
  Inherited Destroy;
End;

Procedure THalcyonxQuery.Loaded;
Begin
  Inherited Loaded;
  OnIndexNeededfor := IndexNeededfor;
  OnSetRange := SetRange;
  OnCancelRange := CancelRange;
  OnCreateTable := CreateTable;
  OnCreateIndex := CreateIndex;
  OnDropTable := DropTable;
  OnDropIndex := DropIndex;
  OnBeforeQuery := BeforeQuery;
  OnAfterQuery := AfterQuery;
  OnSetFilter := SetFilter;
  OnCancelFilter := CancelFilter;
End;

Procedure THalcyonxQuery.IndexNeededfor( Sender: TObject;
  DataSet: TDataset;
  Const FieldNames: String;
  ActivateIndex: Boolean;
  IsJoining: Boolean; Var Accept: Boolean );
Var
  i: integer;
  fNames: String;
Begin
  If IsJoining Then
    Exit;
  Accept := False;
  If WhereOptimizeMethod <> omSetFilter Then
    exit;

  fNames := UpperCase( FieldNames );
  { warning: only simple index expressions accepted:
    FIRSTNAME+LASTNAME}
  ReplaceString( fNames, ';', '+' );
  With THalcyonDataset( DataSet ) Do
  Begin
    For i := 1 To IndexCount Do
      If AnsiCompareText( fNames, UpperCase( IndexExpression( i ) ) ) = 0 Then
      Begin
        Accept := True;
        If ActivateIndex Then
          SetTagTo( IndexTagName( i ) );
      End;
  End;

End;

Procedure THalcyonxQuery.SetRange( Sender: TObject;
  RelOperator: TRelationalOperator;
  DataSet: TDataset;
  Const FieldNames, StartValues, EndValues: String;
  IsJoining: Boolean );

// DecStr - Decrements a string value (ex. 'Hello' -> 'Helln')-------------//
  Function DecStr( sStr: String ): String;
  Var
    iLen: Integer;
  Begin
    iLen := Length( sStr );
    If iLen > 0 Then
    Begin