xquery.pas

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

Begin
  S := GetAsstring;
  Result := (Length(S) > 0) And (S[1] In ['T', 't', 'Y', 'y']);
End;

Procedure TxqStringField.SetAsstring(Const Value: String);
Var
  Buffer: Array[0..dsMaxstringSize] Of Char;
  L: Integer;
Begin
  FillChar(Buffer, fDataSize, 0);
  L := Length(Value);
  StrLCopy(Buffer, PChar(Value), L);
  SetData(@Buffer);
End;

Procedure TxqStringField.SetAsFloat(Value: double);
Begin
  SetAsstring(FloatToStr(Value));
End;

Procedure TxqStringField.SetAsInteger(Value: Longint);
Begin
  SetAsstring(IntToStr(Value));
End;

Procedure TxqStringField.SetAsBoolean(Value: Boolean);
Begin
  SetAsstring(Copy(xqbase.NBoolean[Value], 1, 1));
End;

{-------------------------------------------------------------------------------}
{                  Implements TxqFloatField                                     }
{-------------------------------------------------------------------------------}

Constructor TxqFloatField.Create(Fields: TxqFields; FieldNo: Integer);
Begin
  Inherited Create(Fields, FieldNo);
  SetDataType(ttFloat);
End;

Procedure TxqFloatField.Clear;
Begin
  SetAsFloat(0);
  { LAS : 5/JUN/2002 }
  SetIsNull;
End;

Function TxqFloatField.GetAsVariant: Variant;
Var
  d: Double;
Begin
  If GetData(@d) Then Result:= d Else Result:= Null;
End;

Procedure TxqFloatField.SetVarValue(const Value: Variant);
Begin
  SetAsFloat(Value);
End;

Function TxqFloatField.GetAsFloat: double;
Begin
  If Not GetData(@Result) Then
    Result := 0;
End;

Function TxqFloatField.GetAsInteger: Longint;
Begin
  Result := Longint(Round(GetAsFloat));
End;

Function TxqFloatField.GetAsstring: String;
Var
  F: double;
Begin
  If GetData(@F) Then
    Result := FloatToStr(F)
  Else
    Result := '';
End;

Procedure TxqFloatField.SetAsFloat(Value: double);
Begin
  SetData(@Value);
End;

Procedure TxqFloatField.SetAsInteger(Value: Longint);
Begin
  SetAsFloat(Value);
End;

Procedure TxqFloatField.SetAsstring(Const Value: String);
Var
  F: Extended;
Begin
  If Value = '' Then
    Clear
  Else
  Begin
    If Not TextToFloat(PChar(Value), F, fvExtended) Then
      ExQueryError.CreateFmt(SIsInvalidFloatValue, [Value]);
    SetAsFloat(F);
  End;
End;

{-------------------------------------------------------------------------------}
{                  Implements TxqIntegerField                                   }
{-------------------------------------------------------------------------------}

Constructor TxqIntegerField.Create(Fields: TxqFields; FieldNo: Integer);
Begin
  Inherited Create(Fields, FieldNo);
  SetDataType(ttInteger);
End;

Procedure TxqIntegerField.Clear;
Begin
  SetAsInteger(0);
  { LAS : 5/JUN/2002 }
  SetIsNull;
End;

Function TxqIntegerField.GetAsVariant: Variant;
Var
  v: integer;
Begin
  If GetData(@v) Then Result:= v Else Result:= Null;
End;

Procedure TxqIntegerField.SetVarValue(const Value: Variant);
Begin
  SetAsInteger(Value);
End;

Function TxqIntegerField.GetAsFloat: double;
Begin
  Result := GetAsInteger;
End;

Function TxqIntegerField.GetAsInteger: Longint;
Begin
  If Not GetData(@Result) Then
    Result := 0;
End;

Function TxqIntegerField.GetAsstring: String;
Var
  L: Longint;
Begin
  If GetData(@L) Then
    Str(L, Result)
  Else
    Result := '';
End;

Procedure TxqIntegerField.SetAsFloat(Value: double);
Begin
  SetAsInteger(Integer(Round(Value)));
End;

Procedure TxqIntegerField.SetAsInteger(Value: Longint);
Begin
  SetData(@Value);
End;

Procedure TxqIntegerField.SetAsstring(Const Value: String);
Var
  E: Integer;
  L: Longint;
Begin
  Val(Value, L, E);
  If E <> 0 Then
    ExQueryError.CreateFmt(SIsInvalidIntegerValue, [Value]);
  SetAsInteger(L);
End;

{-------------------------------------------------------------------------------}
{                  Implements TxqBooleanField                                   }
{-------------------------------------------------------------------------------}

Constructor TxqBooleanField.Create(Fields: TxqFields; FieldNo: Integer);
Begin
  Inherited Create(Fields, FieldNo);
  SetDataType(ttBoolean);
End;

Procedure TxqBooleanField.Clear;
Begin
  SetAsBoolean(False);
  { LAS : 5/JUN/2002 }
  SetIsNull;
End;

Function TxqBooleanField.GetAsVariant: Variant;
Var
  b: Boolean;
Begin
  If GetData(@b) Then Result:= b Else Result:= Null;
End;

Procedure TxqBooleanField.SetVarValue(const Value: Variant);
Begin
  SetAsBoolean(Value);
End;

Function TxqBooleanField.GetAsBoolean: Boolean;
Var
  B: WordBool;
Begin
  If GetData(@B) Then
    Result := B
  Else
    Result := False;
End;

Function TxqBooleanField.GetAsstring: String;
Var
  B: WordBool;
Begin
  If GetData(@B) Then
    Result := Copy(xqbase.NBoolean[B], 1, 1)
  Else
    Result := '';
End;

Procedure TxqBooleanField.SetAsBoolean(Value: Boolean);
Var
  B: WordBool;
Begin
  If Value Then
    Word(B) := 1
  Else
    Word(B) := 0;
  SetData(@B);
End;

Procedure TxqBooleanField.SetAsstring(Const Value: String);
Var
  L: Integer;
Begin
  L := Length(Value);
  If L = 0 Then
  Begin
    SetAsBoolean(False);
  End
  Else
  Begin
    If AnsiCompareText(Value, Copy(xqbase.NBoolean[False], 1, L)) = 0 Then
      SetAsBoolean(False)
    Else If AnsiCompareText(Value, Copy(xqbase.NBoolean[True], 1, L)) = 0 Then
      SetAsBoolean(True)
    Else
      ExQueryError.CreateFmt(SIsInvalidBoolValue, [Value]);
  End;
End;

{ TxqFields }

Constructor TxqFields.Create(ResultSet: TResultSet);
Begin
  Inherited Create;
  fResultSet := ResultSet;
  fItems := TList.Create;
End;

Destructor TxqFields.Destroy;
Begin
  Clear;
  fItems.Free;
  Inherited Destroy;
End;

Function TxqFields.FindField(Const FieldName: String): TxqField;
Var
  I: Integer;
Begin
  For I := 0 To fItems.Count - 1 Do
  Begin
    Result := fItems[I];
    If (AnsiCompareText(Result.fFieldName, FieldName) = 0) Or
      (AnsiCompareText(Result.fAlias, FieldName) = 0) Then
      Exit;
  End;
  Result := Nil;
End;

Function TxqFields.GetCount;
Begin
  Result := fItems.Count;
End;

Function TxqFields.GetItem(Index: Integer): TxqField;
Begin
  Result := fItems[Index];
End;

Function TxqFields.Add(DataType: TExprType): TxqField;
Begin
  Result := Nil;
  Case DataType Of
    ttstring: Result := TxqStringField.Create(Self, fItems.Count + 1);
    ttFloat: Result := TxqFloatField.Create(Self, fItems.Count + 1);
    ttInteger: Result := TxqIntegerField.Create(Self, fItems.Count + 1);
    ttBoolean: Result := TxqBooleanField.Create(Self, fItems.Count + 1);
    //ttUnknown: Result:= nil;            { error here if returned nil !}
  End;
  fItems.Add(Result);
End;

Procedure TxqFields.Clear;
Var
  I: Integer;
Begin
  For I := 0 To fItems.Count - 1 Do
    TxqField(fItems[I]).Free;
  fItems.Clear;
End;

Procedure TxqFields.Delete(Index: Integer);
Begin
  TxqField(fItems[Index]).Free;
  fItems.Delete(Index);
End;

{-------------------------------------------------------------------------------}
{                  Implements TResultSet                                        }
{-------------------------------------------------------------------------------}

Constructor TResultSet.Create;
Begin
  Inherited Create;
  fFields := TxqFields.Create(Self);
  fRecNo := -1;
  { first sizeof(TBookmark) bytes is the SourceBookmark for every table}
  fRecordBufferSize := SizeOf(Integer);
End;

Destructor TResultSet.Destroy;
Begin
  fFields.Free;
  Inherited Destroy;
End;

Procedure TResultSet.Clear;
Begin
  fFields.Clear;
End;

Function TResultSet.FindField(Const FieldName: String): TxqField;
Begin
  Result := fFields.FindField(FieldName);
End;

Function TResultSet.FieldByName(Const FieldName: String): TxqField;
Begin
  Result := FindField(FieldName);
  If Result = Nil Then
    ExQueryError.CreateFmt(SFieldNotFound, [FieldName]);
End;

Function TResultSet.GetFieldData(Field: TxqField; Buffer: Pointer): Boolean;
Begin
  Result := False;
End;

Function TResultSet.GetIsNull(Field: TxqField): Boolean;
Begin
  Result := True;
End;

{ LAS : 5/JUN/2002 }
Procedure TResultSet.SetIsNull(Field: TxqField);
Begin
End;

Procedure TResultSet.AddField(Const pFieldName, pAlias: String;
  pDataType: TExprType;
  pDataSize: Integer;
  pField: TField;