jvqxmldatabase.pas

East make Tray Icon in delphi

          end;
      end;

      if not TJvXMLQueryOrder(FOrders[I]).Ascending then
        Result := - Result;
      Exit;
    end;
  end;
end;

procedure TJvXMLQueryParser.OrderTable(var ATable: TJvSimpleXMLElem);
begin
  FOrderTable := ATable;
  ATable.Items.CustomSort(OrderCallBack);
end;

procedure TJvXMLQueryParser.Parse(const AQuery: string);
var
  St: string;
  LStatements: array of string;
  I, J: Integer;
begin
  FQuery := AQuery;

  FInstructionStr := ReadToken;
  DoValidateInstruction;

  case Instruction of
    xiSelect:
      begin
        St := ReadColumns(['FROM', 'WHERE', 'ORDER', 'LIMIT'], False);
        SetLength(LStatements, 4);
        LStatements[0] := 'FROM';
        LStatements[1] := 'WHERE';
        LStatements[2] := 'ORDER';
        LStatements[3] := 'LIMIT';
      end;
    xiDelete:
      begin
        ReadToken; //pass the FROM keyword
        St := 'FROM';
        SetLength(LStatements, 2);
        LStatements[0] := 'FROM';
        LStatements[1] := 'WHERE';
      end;
    xiUpdate:
      begin
        St := 'FROM';
        SetLength(LStatements, 3);
        LStatements[0] := 'FROM';
        LStatements[1] := 'SET';
        LStatements[2] := 'WHERE';
      end;
    xiInsert:
      begin
        St := 'FROM';
        SetLength(LStatements, 3);
        LStatements[0] := 'FROM';
        LStatements[1] := 'VALUES';
        LStatements[2] := 'COLUMNS';
        ReadToken; // Pass the into statement

        //Modify query for lightness of parser
        //INSERT INTO file.XML(Col1, Col2) VALUES(val1, val2)
        // into
        //INSERT INTO file.XML COLUMNS col1, col2 VALUES val1, val2
        FQuery := StringReplace(FQuery, '()', '', [rfReplaceAll]);
        FQuery := StringReplace(FQuery, ')', ' ', [rfReplaceAll]);
        FQuery := StringReplace(FQuery, '(', ' COLUMNS ', []);
        FQuery := StringReplace(FQuery, '(', ' ', []);
      end;
  end;

  while St <> '' do
  begin
    J := -1;
    for I := 0 to Length(LStatements) - 1 do
      if LStatements[I] = St then
      begin
        LStatements[I] := ''; //Do not accept it anymore
        J := I;
        Break;
      end;
    if J = -1 then
      raise TJvXMLDatabaseException.CreateResFmt(@RsEUnexpectedStatement, [St]);

    if St = 'FROM' then
      St := ReadTables(LStatements)
    else
    if St = 'WHERE' then
      St := ReadWhere(LStatements)
    else
    if St = 'LIMIT' then
      St := ReadLimit(LStatements)
    else
    if St = 'ORDER' then
      St := ReadOrderBy(LStatements)
    else
    if St = 'SET' then
      St := ReadSet(LStatements)
    else
    if St = 'VALUES' then
      St := ReadValues(LStatements)
    else
    if St = 'COLUMNS' then
      St := ReadColumns(LStatements, False);
  end;
end;

function TJvXMLQueryParser.ReadColumns(const AEndStatement: array of string;
  ACanTerminate: Boolean): string;
begin
  Result := ReadStatement(AEndStatement, ACanTerminate, FColumnsStr);
  DoValidateColumns;
end;

function TJvXMLQueryParser.ReadLimit(const AEndStatement: array of string): string;
var
  I: Integer;
begin
  Result := ReadStatement(AEndStatement, True, FLimitStr);
  I := Pos(',', FLimitStr);
  if I = 0 then
    FLimitCount := StrToIntDef(FLimitStr, MaxInt)
  else
  begin
    FLimitCount := StrToIntDef(Trim(Copy(FLimitStr, I + 1, MaxInt)), MaxInt);
    FLimitBegin := StrToIntDef(Trim(Copy(FLimitStr, 1, I - 1)), 0);
  end;
end;

function TJvXMLQueryParser.ReadOrderBy(const AEndStatement: array of string): string;
begin
  Result := ReadStatement(AEndStatement, True, FOrderStr);
  DoValidateOrderBy;
end;

function TJvXMLQueryParser.ReadSet(const AEndStatement: array of string): string;
begin
  Result := ReadStatement(AEndStatement, True, FSetStr);
  DoValidateSet;
end;

function TJvXMLQueryParser.ReadStatement(const AEndStatement: array of string;
  ACanTerminate: Boolean; var AValue: string): string;
var
  St, UpSt: string;
  LFound: Boolean;
  I: Integer;
begin
  AValue := '';
  LFound := False;
  Result := '';
  while not LFound do
    if (FQuery = '') and ACanTerminate then
      LFound := True
    else
    begin
      St := ReadToken;
      if St <> '' then
      begin
        UpSt := UpperCase(St);
        for I := 0 to Length(AEndStatement) - 1 do
          if UpSt = AEndStatement[I] then
          begin
            LFound := True;
            Break;
          end;
      end;

      if not LFound then
        AValue := AValue + ' ' + St
      else
        Result := St;
    end;
end;

function TJvXMLQueryParser.ReadTables(const AEndStatement: array of string): string;
begin
  Result := ReadStatement(AEndStatement, True, FTablesStr);
  DoValidateTables;
end;

function TJvXMLQueryParser.ReadToken: string;
var
  I: Integer;
begin
  if FQuery = '' then
    raise TJvXMLDatabaseException.CreateRes(@RsEUnexpectedEndOfQuery);

  FQuery := TrimLeft(FQuery);
  I := 1;
  while (I < Length(FQuery)) and not (FQuery[I] in [' ']) do  {,'(',')'}
    Inc(I);
  if I >= Length(FQuery) then
  begin
    Result := Trim(FQuery);
    FQuery := '';
  end
  else
  begin
    Result := Copy(FQuery, 1, I - 1);
    FQuery := Copy(FQuery, I + 1, MaxInt);
  end;
end;

function TJvXMLQueryParser.ReadValues(const AEndStatement: array of string): string;
begin
  Result := ReadStatement(AEndStatement, True, FValuesStr);
  DoValidateValues;
end;

function TJvXMLQueryParser.ReadWhere(const AEndStatement: array of string): string;
begin
  Result := ReadStatement(AEndStatement, True, FWhereStr);
  DoValidateWhere;
end;

procedure TJvXMLQueryParser.UpdateRow(ARow: TJvSimpleXMLElem);
var
  I: Integer;
begin
  for I := 0 to FUpdates.Count - 1 do
    TJvXMLQueryAssignement(FUpdates[I]).UpdateElem(ARow);
end;

//=== { TJvXMLQueryColumn } ==================================================

constructor TJvXMLQueryColumn.Create(const AValue: string);
var
  I: Integer;
begin
  inherited Create;
  I := Pos('.', AValue);
  if I <> 0 then
  begin
    Name := Copy(AValue, I + 1, MaxInt);
    Table := Copy(AValue, 1, I - 1);
  end
  else
    Name := AValue;
end;

//=== { TJvXMLQueryTable } ===================================================

constructor TJvXMLQueryTable.Create(const AValue: string);
var
  I: Integer;
begin
  inherited Create;
  I := Pos(' ', AValue);
  if I <> 0 then
  begin
    Name := Copy(AValue, 1, I - 1);
    Alias := Trim(Copy(AValue, I + 1, MaxInt));
  end
  else
    Name := AValue;
end;

//=== { TJvXMLQueryCondition } ===============================================

constructor TJvXMLQueryCondition.Create(AOperator: TJvXMLSQLOperator;
  const ACondition: string);
begin
  inherited Create;
  Self.Operator := AOperator;
  Self.Condition := ACondition;
end;

//=== { TJvXMLQueryOrder } ===================================================

constructor TJvXMLQueryOrder.Create(const AValue: string);
var
  I: Integer;
  St: string;
begin
  inherited Create;
  Column := Trim(AValue);
  Ascending := True;
  Convertion := ocNone;

  I := Pos(' ', Column);
  if I <> 0 then
  begin
    SetLength(Column, I - 1);
    Ascending := Pos('ASC', UpperCase(AValue)) <> 0;
  end;

  I := Pos('(', Column);
  if I <> 0 then
  begin
    St := UpperCase(Copy(Column, 1, I - 1));
    Column := Copy(Column, I + 1, MaxInt);
    SetLength(Column, Length(Column) - 1);

    if St = 'DATE' then
      Convertion := ocDate
    else
    if (St = 'Integer') or (St = 'INT') then
      Convertion := ocInteger
    else
    if St = 'FLOAT' then
      Convertion := ocFloat;
  end;
end;

//=== { TJvXMLQueryAssignement } =============================================

constructor TJvXMLQueryAssignement.Create(AValue: string);
var
  I, J: Integer;
  LDelimiter: Char;
begin
  inherited Create;
  I := Pos('=', AValue);
  if I = 0 then
    // (rom) this definitely neds to be improved
    raise Exception.Create('')
  else
  begin
    Column := Trim(Copy(AValue, 1, I - 1));
    AValue := Trim(Copy(AValue, I + 1, MaxInt));

    if AValue = '' then
      raise Exception.Create('');

    //Determine if column or constant
    if (AValue[1] = '"') or (AValue[1] = '''') then
    begin
      LDelimiter := AValue[1];
      ValueKind := skConstant;
      AValue := Copy(AValue, 2, MaxInt);
      I := 0;
      for J := 1 to Length(AValue) do
        if AValue[J] = LDelimiter then
          if (J=1) or (AValue[J-1] <> '\') then
          begin
            I := J;
            Break;
          end;
      if I <> 0 then
      begin
        Value := Copy(AValue, 1, I - 1);
        Value := StringReplace(Value, '\' + LDelimiter, LDelimiter, [rfReplaceAll]);
        AValue := Trim(Copy(AValue, I + 1, MaxInt));
      end
      else
        raise Exception.Create('');        
    end
    else
    begin
      ValueKind := skColumn;
      I := Pos(' ', AValue);
      if I = 0 then
      begin
        Value := AValue;
        AValue := '';
      end
      else
      begin
        Value := Copy(AValue, 1, I - 1);
        AValue := Trim(Copy(AValue, I + 1, MaxInt));
      end;
    end;

    //Second kind and second value?
    if AValue = '' then
      Operator := soNone
    else
    begin
      case AValue[1] of
        '+':
          Operator := soAdd;
        '-':
          Operator := soSubstract;
        '*':
          Operator := soMultiply;
        '/':
          Operator := soDivide;
        else
          raise Exception.Create('');
      end;

      SecondValue := Trim(Copy(AValue, 2, MaxInt));
      if (SecondValue <> '') and (SecondValue[1] in ['''','"']) then
      begin
        SecondValue := Copy(SecondValue, 2, Length(SecondValue) - 2);
        SecondKind := skConstant;
      end
      else
        SecondKind := skColumn;
    end;
  end;
end;

procedure TJvXMLQueryAssignement.UpdateElem(AElement: TJvSimpleXMLElem);
var
  LValue, LValue2: string;

  function ParseValue(const AValue: string): string;
  begin
    if SameText(AValue, 'now()') then
      Result := DateTimeToStr(Now)
    else
      Result := AValue;
  end;

begin
  if ValueKind = skConstant then
    LValue := Value
  else
    LValue := AElement.Properties.Value(Value, ParseValue(Value));

  if Operator <> soNone then
  begin
    if SecondKind = skConstant then
      LValue2 := SecondValue
    else
      LValue2 := AElement.Properties.Value(SecondValue, ParseValue(SecondValue));
    case Operator of
      soAdd:
        LValue := FloatToStr(StrToFloatDef(LValue,0) + StrToFloatDef(LValue2,0));
      soMultiply:
        LValue := FloatToStr(StrToFloatDef(LValue,0) * StrToFloatDef(LValue2,0));
      soDivide:
        LValue := FloatToStr(StrToFloatDef(LValue,0) / StrToFloatDef(LValue2,0));
      soSubstract:
        LValue := FloatToStr(StrToFloatDef(LValue,0) - StrToFloatDef(LValue2,0));
    end;
  end;

  AElement.Properties.Delete(Column);
  AElement.Properties.Add(Column, LValue);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQXmlDatabase.pas,v $';
    Revision: '$Revision: 1.19 $';
    Date: '$Date: 2004/09/07 23:11:36 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.