jvqxmldatabase.pas

East make Tray Icon in delphi

          opLeftParenthesis:
            begin
              Inc(AIndex);
              Result := Result and (CheckCondition(AIndex));
            end;
          opRightParenthesis:
            Exit;
          opNot:
            begin
              Inc(AIndex);
              Result := Result and (not CheckCondition(AIndex));
            end;
          opColumn, opConstant:
            begin
              if Operator = opConstant then
                LValue := Condition
              else
              begin
                if Condition = 'daysbetweennow' then
                begin
                  Inc(AIndex, 2);
                  LValue := AXMLElem.Properties.Value(TJvXMLQueryCondition(FConditions[AIndex]).Condition);
                  Inc(AIndex);
                  LDate := StrToDateTimeDef(LValue, 0);
                  LValue := IntToStr(DaysBetween(Now, LDate));
                  if LDate < Now then
                    LValue := '-' + LValue;
                end
                else
                  LValue := AXMLElem.Properties.Value(Condition);
              end;
              Inc(AIndex, 2);
              if AIndex >= FConditions.Count then
              begin
                Result := False;
                Exit;
              end;
              LComp := TJvXMLQueryCondition(FConditions[AIndex-1]).Operator;

              if TJvXMLQueryCondition(FConditions[AIndex]).Operator = opConstant then
                LValue2 := TJvXMLQueryCondition(FConditions[AIndex]).Condition
              else
              if TJvXMLQueryCondition(FConditions[AIndex]).Operator = opColumn then
              begin
                LValue2 := TJvXMLQueryCondition(FConditions[AIndex]).Condition;
                if AXMLElem.Properties.ItemNamed[LValue2] <> nil then
                  LValue2 := AXMLElem.Properties.Value(LValue2);
              end
              else
              if (TJvXMLQueryCondition(FConditions[AIndex]).Operator = opNull) and (LComp = opEquals) then
              begin
                Result := Result and (LValue = '');
                LComp := opNone;
              end
              else
              begin
                Result := False;
                LComp := opNone;
              end;

              try
                case LComp of
                  opEquals:
                    Result := Result and (LValue = LValue2);
                  opGreater:
                    Result := Result and (StrToFloat(LValue) > StrToFloat(LValue2));
                  opSmaller:
                    Result := Result and (StrToFloat(LValue) < StrToFloat(LValue2));
                  opGreaterEquals:
                    Result := Result and (StrToFloat(LValue) >= StrToFloat(LValue2));
                  opSmallerEquals:
                    Result := Result and (StrToFloat(LValue) <= StrToFloat(LValue2));
                  opLike:
                    begin
                      //Not implemented yet
                    end;
                end;
              except
                Result := False;
              end;
            end;
          opOr:
            begin
              Inc(AIndex);
              Result := Result or CheckCondition(AIndex);
            end;
          opAnd:
            begin
              Inc(AIndex);
              Result := Result and CheckCondition(AIndex);
            end;
          opXor:
            begin
              Inc(AIndex);
              Result := Result xor CheckCondition(AIndex);
            end;
        end;
      Inc(AIndex);
    end;
  end;

begin
  I := 0;
  Result := CheckCondition(I);
end;

procedure TJvXMLQueryParser.DoValidateColumns;
var
  I: Integer;
  LColumn: TJvXMLQueryColumn;
begin
  I := Pos(',', FColumnsStr);
  repeat
    if I <> 0 then
    begin
      LColumn := TJvXMLQueryColumn.Create(Trim(Copy(FColumnsStr, 1, I - 1)));
      FColumns.Add(LColumn);
      FColumnsStr := Trim(Copy(FColumnsStr, I + 1, MaxInt));
      I := Pos(',', FColumnsStr);
    end
    else
    if FColumnsStr <> '' then
    begin
      LColumn := TJvXMLQueryColumn.Create(Trim(FColumnsStr));
      FColumns.Add(LColumn);
      FColumnsStr := '';
    end;
  until FColumnsStr = '';
end;

procedure TJvXMLQueryParser.DoValidateInstruction;
begin
  FInstructionStr := UpperCase(FInstructionStr);

  if FInstructionStr = 'SELECT' then
    FInstruction := xiSelect
  else
  if FInstructionStr = 'UPDATE' then
    FInstruction := xiUpdate
  else
  if FInstructionStr = 'INSERT' then
    FInstruction := xiInsert
  else
  if FInstructionStr = 'DELETE' then
    FInstruction := xiDelete
  else
    raise TJvXMLDatabaseException.CreateResFmt(@RsEUnknownInstruction, [FInstructionStr]);
end;

procedure TJvXMLQueryParser.DoValidateOrderBy;
var
  I: Integer;
  LOrder: TJvXMLQueryOrder;
begin
  FOrderStr := Trim(UpperCase(FOrderStr));
  I := Pos(' ', FOrderStr);
  if I <> 0 then
    FOrderStr := Trim(Copy(FOrderStr, I + 1, MaxInt));

  I := Pos(',', FOrderStr);
  repeat
    if I <> 0 then
    begin
      LOrder := TJvXMLQueryOrder.Create(Trim(Copy(FOrderStr, 1, I - 1)));
      FOrders.Add(LOrder);
      FOrderStr := Trim(Copy(FOrderStr, I + 1, MaxInt));
      I := Pos(',', FOrderStr);
    end
    else
    if FOrderStr <> '' then
    begin
      LOrder := TJvXMLQueryOrder.Create(Trim(FOrderStr));
      FOrders.Add(LOrder);
      FOrderStr := '';
    end;
  until FOrderStr = '';
end;

procedure TJvXMLQueryParser.DoValidateSet;
var
  I: Integer;
  LSet: TJvXMLQueryAssignement;
begin
  FSetStr := Trim(FSetStr);
  I := Pos(',', FSetStr);
  repeat
    if I <> 0 then
    begin
      LSet := TJvXMLQueryAssignement.Create(Trim(Copy(FSetStr, 1, I - 1)));
      FUpdates.Add(LSet);
      FSetStr := Trim(Copy(FSetStr, I + 1, MaxInt));
      I := Pos(',', FSetStr);
    end
    else
    if FSetStr <> '' then
    begin
      LSet := TJvXMLQueryAssignement.Create(Trim(FSetStr));
      FUpdates.Add(LSet);
      FSetStr := '';
    end;
  until FSetStr = '';
end;

procedure TJvXMLQueryParser.DoValidateTables;
var
  I: Integer;
  LTable: TJvXMLQueryTable;
begin
  I := Pos(',', FTablesStr);
  repeat
    if I <> 0 then
    begin
      LTable := TJvXMLQueryTable.Create(Trim(Copy(FTablesStr, 1, I - 1)));
      FTables.Add(LTable);
      FTablesStr := Trim(Copy(FTablesStr, I + 1, MaxInt));
      I := Pos(',', FTablesStr);
    end
    else
    if FTablesStr <> '' then
    begin
      LTable := TJvXMLQueryTable.Create(Trim(FTablesStr));
      FTables.Add(LTable);
      FTablesStr := '';
    end;
  until FTablesStr = '';
end;

procedure TJvXMLQueryParser.DoValidateValues;
var
  I: Integer;

  function ParseValue(const AValue: string): string;
  begin
    Result := Trim(AValue);

    //Escape quotes
    if (Result <> '') and (Result[1] in ['''','"']) then
      Result := Copy(Result, 2, Length(Result) - 2);

    if SameText(Result, 'now') then
      Result := DateTimeToStr(Now);
  end;

begin
  I := Pos(',', FValuesStr);
  repeat
    if I <> 0 then
    begin
      FValues.Add(ParseValue(Trim(Copy(FValuesStr,1,I - 1))));
      FValuesStr := Trim(Copy(FValuesStr, I + 1, MaxInt));
      I := Pos(',', FValuesStr);
    end
    else
    if FValuesStr<>'' then
    begin
      FValues.Add(ParseValue(Trim(FValuesStr)));
      FValuesStr := '';
    end;
  until FValuesStr = '';
end;

procedure TJvXMLQueryParser.DoValidateWhere;
var
  LToken: string;
  I, WhereStrLen: Integer;
  LChar: Char;

  procedure AddToken(const AToken: string);
  begin
    LToken := LowerCase(LToken);

    if LToken = 'and' then
      FConditions.Add(TJvXMLQueryCondition.Create(opAnd))
    else
    if LToken = 'or' then
      FConditions.Add(TJvXMLQueryCondition.Create(opOr))
    else
    if LToken = 'like' then
      FConditions.Add(TJvXMLQueryCondition.Create(opLike))
    else
    if LToken = 'xor' then
      FConditions.Add(TJvXMLQueryCondition.Create(opXor))
    else
    if LToken = 'is' then
      FConditions.Add(TJvXMLQueryCondition.Create(opEquals))
    else
    if LToken = 'null' then
      FConditions.Add(TJvXMLQueryCondition.Create(opNull))
    else
      FConditions.Add(TJvXMLQueryCondition.Create(opColumn,LToken));
  end;

begin
  FWhereStr := FWhereStr + ' ';
  WhereStrLen := Length(FWhereStr);
  I := 1;
  LToken := '';
  while I < WhereStrLen do
  begin
    case FWhereStr[I] of
      '(':
        begin
          if LToken<>'' then
          begin
            AddToken(LToken);
            LToken := '';
          end;
          FConditions.Add(TJvXMLQueryCondition.Create(opLeftParenthesis));
        end;
      ')':
        begin
          if LToken<>'' then
          begin
            AddToken(LToken);
            LToken := '';
          end;
          FConditions.Add(TJvXMLQueryCondition.Create(opRightParenthesis));
        end;
      'a'..'z', 'A'..'Z', '0'..'9', '_':
        LToken := LToken + FWhereStr[I];
      ' ':
        if LToken <> '' then
        begin
          AddToken(LToken);
          LToken := '';
        end;
      '=':
        FConditions.Add(TJvXMLQueryCondition.Create(opEquals));
      '>':
        begin
          Inc(I);
          if I < WhereStrLen then
          begin
            if FWhereStr[I] = '=' then
              FConditions.Add(TJvXMLQueryCondition.Create(opGreaterEquals))
            else
            begin
              FConditions.Add(TJvXMLQueryCondition.Create(opGreater));
              Dec(I);
            end;
          end;
        end;
      '<':
        begin
          Inc(I);
          if I < WhereStrLen then
          begin
            if FWhereStr[I] = '=' then
              FConditions.Add(TJvXMLQueryCondition.Create(opSmallerEquals))
            else
            begin
              FConditions.Add(TJvXMLQueryCondition.Create(opSmaller));
              Dec(I);
            end;
          end;
        end;
      '''', '"':
        begin
          LChar := FWhereStr[I];
          Inc(I);
          LToken := '';
          while (I < WhereStrLen) and (FWhereStr[I] <> LChar) do
          begin
            LToken := LToken + FWhereStr[I];
            Inc(I);
          end;
          FConditions.Add(TJvXMLQueryCondition.Create(opConstant,LToken));
          LToken := '';
        end;
    end;
    Inc(I);
  end;
end;

function TJvXMLQueryParser.GetColumn(const AIndex: Integer): TJvXMLQueryColumn;
begin
  Result := TJvXMLQueryColumn(FColumns[AIndex]);
end;

function TJvXMLQueryParser.GetColumnsCount: Integer;
begin
  Result := FColumns.Count;
end;

function TJvXMLQueryParser.GetCondition(const AIndex: Integer): TJvXMLQueryCondition;
begin
  Result := TJvXMLQueryCondition(FConditions[AIndex]);
end;

function TJvXMLQueryParser.GetConditionsCount: Integer;
begin
  Result := FConditions.Count;
end;

function TJvXMLQueryParser.GetTable(const AIndex: Integer): TJvXMLQueryTable;
begin
  Result := TJvXMLQueryTable(FTables[AIndex]);
end;

function TJvXMLQueryParser.GetTablesCount: Integer;
begin
  Result := FTables.Count;
end;

function TJvXMLQueryParser.GetValue(const AIndex: Integer): string;
begin
  Result := FValues[AIndex];
end;

function TJvXMLQueryParser.GetValuesCount: Integer;
begin
  Result := FValues.Count;
end;

procedure TJvXMLQueryParser.LimitTable(var ATable: TJvSimpleXMLElem);
begin
  while (FLimitBegin > 0) and (ATable.Items.Count > 0) do
  begin
    ATable.Items.Delete(0);
    Dec(FLimitBegin);
  end;
  while (ATable.Items.Count > FLimitCount) do
    ATable.Items.Delete(ATable.Items.Count - 1);
end;

function TJvXMLQueryParser.OrderCallBack(Elems: TJvSimpleXMLElems;
  Index1, Index2: Integer): Integer;
var
  I: Integer;
  LStr1, LStr2: string;
  LFloat1, LFloat2: Double;
begin
  Result := 0;

  for I := 0 to FOrders.Count-1 do
  begin
    LStr1 := FOrderTable.Items[Index1].Properties.Value(TJvXMLQueryOrder(FOrders[I]).Column);
    LStr2 := FOrderTable.Items[Index2].Properties.Value(TJvXMLQueryOrder(FOrders[I]).Column);
    if LStr1 <> LStr2 then
    begin
      //convert to date/int
      case TJvXMLQueryOrder(FOrders[I]).Convertion of
        ocNone:
          Result := AnsiCompareStr(LStr1, LStr2);
        ocDate:
          Result := CompareDateTime(StrToDateTimeDef(LStr1, 0), StrToDateTimeDef(LStr2, 0));
        ocInteger:
          Result := StrToIntDef(LStr1, 0) - StrToIntDef(LStr2, 0);
        ocFloat:
          begin
            LFloat1 := StrToFloatDef(LStr1, 0);
            LFloat2 := StrToFloatDef(LStr2, 0);
            if LFloat1 > LFloat2 then
              Result := 1
            else
            if LFloat1 < LFloat2 then
              Result := -1;