jvqxmldatabase.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvXMLDatabase.PAS, released on 2003-06-22.

The Initial Developer of the Original Code is S閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2003 S閎astien Buysse.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
  -You have to place the columns you test in the where clause in the select clause too
  -Where conditions *MUST* be enclosed between parenthesis as ... WHERE (Col = 5) AND (Col2 < Col3) ...
  -Update statements are limited to simple operations like ... SET Col1 = Col1 + 1, Col2 = 4 ...
-----------------------------------------------------------------------------}
// $Id: JvQXmlDatabase.pas,v 1.19 2004/09/07 23:11:36 asnepvangers Exp $

unit JvQXmlDatabase;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes, Contnrs, Math, 
  DateUtils, 
  JvQTypes, JvQComponent, JvQSimpleXml;

type
  TJvXMLDatabase = class;
  TJvXMLQuery = class;
  TJvXMLQueryParser = class;
  TJvXMLDatabaseException = class(EJVCLException);

  TJvXMLTable = class(TObject)
  public
    XML: TJvSimpleXML;
    Locked: Boolean;
    FileName: string;
  end;

  TJvXMLQueryTable = class(TObject)
  public
    Name: string;
    Alias: string;
    constructor Create(const AValue: string);
  end;

  TJvXMLQueryColumn = class(TObject)
  public
    Name: string;
    Table: string;
    constructor Create(const AValue: string);
  end;

  TJvXMLOrderConvertion = (ocNone, ocDate, ocInteger, ocFloat);

  TJvXMLQueryOrder = class(TObject)
  public
    Column: string;
    Ascending: Boolean;
    Convertion: TJvXMLOrderConvertion;
    constructor Create(const AValue: string);
  end;

  TJvXMLSQLOperator = (opEquals, opGreater, opSmaller, opGreaterEquals,
    opSmallerEquals, opLike, opNot, opOr, opAnd, opXor, opLeftParenthesis,
    opRightParenthesis, opConstant, opColumn, opNull, opNone);

  TJvXMLQueryCondition = class(TObject)
  public
    Condition: string;
    Operator: TJvXMLSQLOperator;
    constructor Create(AOperator: TJvXMLSQLOperator; const ACondition: string = '');
  end;

  TJvXMLSetKind = (skConstant, skColumn);
  TJvXMLSetOperator = (soNone, soAdd, soMultiply, soDivide, soSubstract);

  TJvXMLQueryAssignement = class(TObject)
  public
    Column: string;
    ValueKind: TJvXMLSetKind;
    SecondKind: TJvXMLSetKind;
    Operator: TJvXMLSetOperator;
    Value: string;
    SecondValue: string;
    constructor Create(AValue: string);
    procedure UpdateElem(AElement: TJvSimpleXMLElem);
  end;

  TJvXMLInstruction = (xiSelect, xiUpdate, xiInsert, xiDelete);
  TJvXMLQueryParser = class(TObject)
  private
    FQuery: string;
    FTables: TObjectList;
    FColumns: TObjectList;
    FConditions: TObjectList;
    FOrders: TObjectList;
    FInstruction: TJvXMLInstruction;
    FInstructionStr: string;
    FTablesStr: string;
    FWhereStr: string;
    FColumnsStr: string;
    FLimitStr: string;
    FLimitBegin: Integer;
    FLimitCount: Integer;
    FOrderStr: string;
    FSetStr: string;
    FOrderTable: TJvSimpleXMLElem;
    FUpdates: TObjectList;
    FValuesStr: string;
    FValues: TStringList;
    function GetColumn(const AIndex: Integer): TJvXMLQueryColumn;
    function GetTable(const AIndex: Integer): TJvXMLQueryTable;
    function GetColumnsCount: Integer;
    function GetTablesCount: Integer;
    function GetCondition(const AIndex: Integer): TJvXMLQueryCondition;
    function GetConditionsCount: Integer;
    function OrderCallBack(Elems: TJvSimpleXMLElems; Index1, Index2: Integer): Integer;
    function GetValue(const AIndex: Integer): string;
    function GetValuesCount: Integer;
  protected
    function ReadToken: string;
    function ReadColumns(const AEndStatement: array of string; ACanTerminate: Boolean): string;
    function ReadTables(const AEndStatement: array of string): string;
    function ReadWhere(const AEndStatement: array of string): string;
    function ReadLimit(const AEndStatement: array of string): string;
    function ReadOrderBy(const AEndStatement: array of string): string;
    function ReadSet(const AEndStatement: array of string): string;
    function ReadValues(const AEndStatement: array of string): string;
    function ReadStatement(const AEndStatement: array of string;
      ACanTerminate: Boolean; var AValue: string): string;
    procedure DoValidateInstruction;
    procedure DoValidateColumns;
    procedure DoValidateTables;
    procedure DoValidateWhere;
    procedure DoValidateOrderBy;
    procedure DoValidateSet;
    procedure DoValidateValues;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Parse(const AQuery: string);
    function CheckConditions(AXMLElem: TJvSimpleXMLElem): Boolean;
    procedure LimitTable(var ATable: TJvSimpleXMLElem);
    procedure OrderTable(var ATable: TJvSimpleXMLElem);
    procedure UpdateRow(ARow: TJvSimpleXMLElem);
    property Instruction: TJvXMLInstruction read FInstruction write FInstruction;
    property Tables[const AIndex: Integer]: TJvXMLQueryTable read GetTable;
    property TablesCount: Integer read GetTablesCount;
    property Columns[const AIndex: Integer]: TJvXMLQueryColumn read GetColumn;
    property ColumnsCount: Integer read GetColumnsCount;
    property Condition[const AIndex: Integer]: TJvXMLQueryCondition read GetCondition;
    property ConditionsCount: Integer read GetConditionsCount;
    property Value[const AIndex: Integer]: string read GetValue;
    property ValuesCount: Integer read GetValuesCount;
  end;

  TJvXMLQuery = class(TObject)
  private
    FParser: TJvXMLQueryParser;
    FDatabase: TJvXMLDatabase;
    FResults: TJvSimpleXMLElem;
    FTables: TList;
    FLastId: Integer;
  protected
    procedure Query(const AQuery: string);
  public
    constructor Create(AOwner: TJvXMLDatabase);
    destructor Destroy; override;

    property Results: TJvSimpleXMLElem read FResults;
    property LastId: Integer read FLastId;
  end;

  TJvXMLDatabase = class(TJvComponent)
  private
    FTablesPath: string;
    FTables: TObjectList;
  protected
    function GetTable(const AName: string): TJvSimpleXML;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    procedure SaveTables;
    function Query(const AQuery: string): TJvXMLQuery;
    property TablesPath: string read FTablesPath write FTablesPath;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQJCLUtils, JvQResources;

//=== { TJvXMLDatabase } =====================================================

constructor TJvXMLDatabase.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTables := TObjectList.Create;
end;

destructor TJvXMLDatabase.Destroy;
begin
  FTables.Free;
  inherited Destroy;
end;

function TJvXMLDatabase.GetTable(const AName: string): TJvSimpleXML;
var
  I: Integer;
  St: string;
  LTable: TJvXMLTable;
begin
  St := TablesPath + AName;
  for I := 0 to FTables.Count-1 do
    if TJvXMLTable(FTables[I]).FileName = St then
    begin
      Result := TJvXMLTable(FTables[I]).XML;
      Exit;
    end;

  LTable := TJvXMLTable.Create;
  LTable.XML := TJvSimpleXML.Create(nil);
  LTable.XML.LoadFromFile(St);
  LTable.Locked := False;
  LTable.FileName := St;
  FTables.Add(LTable);
  Result := LTable.XML;
end;

function TJvXMLDatabase.Query(const AQuery: string): TJvXMLQuery;
begin
  Result := TJvXMLQuery.Create(Self);
  Result.Query(AQuery);
end;

procedure TJvXMLDatabase.SaveTables;
var
  I: Integer;
begin
  for I := 0 to FTables.Count-1 do
    TJvXMLTable(FTables[I]).XML.SaveToFile(TJvXMLTable(FTables[I]).FileName);
end;

//=== { TJvXMLQuery } ========================================================

constructor TJvXMLQuery.Create(AOwner: TJvXMLDatabase);
begin
  inherited Create;
  FDatabase := AOwner;
  FParser := TJvXMLQueryParser.Create;
  FResults := TJvSimpleXMLElemClassic.Create(nil);
  FTables := TList.Create;
end;

destructor TJvXMLQuery.Destroy;
begin
  FParser.Free;
  FResults.Free;
  FTables.Free;
  inherited Destroy;
end;

procedure TJvXMLQuery.Query(const AQuery: string);
var
  I, J, lMax: Integer;
  LElem: TJvSimpleXMLElemClassic;
  LValue: string;

  function IsColumnSelected(const ATable, AColumn: string): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to FParser.ColumnsCount-1 do
      if (FParser.Columns[I].Name = '*') or ((FParser.Columns[I].Name = AColumn) and
        ((FParser.Columns[I].Table = '') or (FParser.Columns[I].Table = ATable))) then
      begin
        Result := True;
        Break;
      end;
  end;

  procedure ConstructTable(AIndex: Integer; var AElem: TJvSimpleXMLElemClassic);
  var
    I, J: Integer;
    LElem: TJvSimpleXMLElemClassic;
  begin
    if AIndex >= FTables.Count then
    begin
      if FParser.CheckConditions(AElem) then
        FResults.Items.Add(AElem)
      else
        AElem.Free;
    end
    else
      with TJvSimpleXML(FTables[AIndex]) do
        for I := 0 to Root.Items.Count-1 do
        begin
          LElem := TJvSimpleXMLElemClassic.Create(nil);
          LElem.Assign(AElem);

          //Select columns to add
          for J := 0 to Root.Items[I].Properties.Count-1 do
            if IsColumnSelected(FParser.Tables[AIndex].Alias, Root.Items[I].Properties[J].Name) then
              LElem.Properties.Add(Root.Items[I].Properties[J].Name, Root.Items[I].Properties[J].Value);

          ConstructTable(AIndex + 1, LElem);
        end;
  end;

  procedure DeleteRows;
  var
    I, J: Integer;
  begin
    for I := 0 to FTables.Count-1 do
      for J := TJvSimpleXML(FTables[I]).Root.Items.Count-1 downto 0 do
        if FParser.CheckConditions(TJvSimpleXML(FTables[I]).Root.Items[J]) then
          TJvSimpleXML(FTables[I]).Root.Items.Delete(J);
  end;

  procedure UpdateRows;
  var
    I, J: Integer;
  begin
    for I := 0 to FTables.Count-1 do
      for J := TJvSimpleXML(FTables[I]).Root.Items.Count - 1 downto 0 do
        if FParser.CheckConditions(TJvSimpleXML(FTables[I]).Root.Items[J]) then
          FParser.UpdateRow(TJvSimpleXML(FTables[I]).Root.Items[J]);
  end;

begin
  //Parse
  FParser.Parse(AQuery);

  //Get all tables
  for I := 0 to FParser.TablesCount-1 do
    FTables.Add(FDatabase.GetTable(FParser.Tables[I].Name));

  //Execute
  case FParser.Instruction of
    xiSelect:
      begin
        LElem := TJvSimpleXMLElemClassic.Create(nil);
        LElem.Name := 'Item';
        FResults.Name := 'Results';
        ConstructTable(0, LElem);
      end;
    xiDelete:
      begin
        DeleteRows;
        FDatabase.SaveTables;
      end;
    xiUpdate:
      begin
        UpdateRows;
        FDatabase.SaveTables;
      end;
    xiInsert:
      begin
        if FTables.Count = 1 then
          with TJvSimpleXML(FTables[0]).Root.Items.Add('item') do
            for I := 0 to FParser.ColumnsCount-1 do
              if I < FParser.ValuesCount then
              begin
                LValue := FParser.Value[I];
                if LValue = 'NULL' then
                begin
                  lMax := 0;
                  for J := 0 to TJvSimpleXML(FTables[0]).Root.Items.Count-1 do
                    lMax := Max(lMax, TJvSimpleXML(FTables[0]).Root.Items[J].Properties.IntValue(FParser.Columns[I].Name, 0));
                  Inc(lMax);
                  LValue := IntToStr(lMax);
                  FLastId := lMax;
                end
                else
                if LValue = 'NOW' then
                  LValue := DateTimeToStr(Now)
                else
                if LValue = 'DATE' then
                  LValue := DateToStr(Now)
                else
                if LValue = 'TIME' then
                  LValue := TimeToStr(Now);
                Properties.Add(FParser.Columns[I].Name, LValue);
              end;
        FDatabase.SaveTables;
      end;
  end;

  FParser.OrderTable(FResults);
  FParser.LimitTable(FResults);
end;

//=== { TJvXMLQueryParser } ==================================================

constructor TJvXMLQueryParser.Create;
begin
  inherited Create;
  FTables := TObjectList.Create;
  FColumns := TObjectList.Create;
  FConditions := TObjectList.Create;
  FOrders := TObjectList.Create;
  FUpdates := TObjectList.Create;
  FValues := TStringList.Create;
  FLimitBegin := 0;
  FLimitCount := MaxInt;
end;

destructor TJvXMLQueryParser.Destroy;
begin
  FTables.Free;
  FColumns.Free;
  FConditions.Free;
  FOrders.Free;
  FUpdates.Free;
  FValues.Free;
  inherited Destroy;
end;

function TJvXMLQueryParser.CheckConditions(AXMLElem: TJvSimpleXMLElem): Boolean;
var
  I: Integer;

  function CheckCondition(var AIndex: Integer): Boolean;
  var
    LComp: TJvXMLSQLOperator;
    LValue, LValue2: string;
    LDate: TDateTime;
  begin
    Result := True;
    while AIndex < FConditions.Count do
    begin
      with TJvXMLQueryCondition(FConditions[AIndex]) do
        case Operator of