xquery.pas

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

  pReadOnly: Boolean;
  pCastType: Integer;
  pCastLen: Integer;
  pUseDisplayLabel: Boolean);
Begin
  With fFields.Add(pDataType) Do
  Begin
    FieldName := pFieldName;
    Alias := pAlias;
    DataType := pDataType;
    SourceField := pField;
    ReadOnly := pReadOnly;
    CastType := pCastType;
    CastLen := pCastLen;
    UseDisplayLabel := pUseDisplayLabel;
    Case CastType Of
      RW_CHAR: DataType := ttstring;
      RW_INTEGER: DataType := ttInteger;
      RW_BOOLEAN: DataType := ttBoolean;
      RW_DATE, RW_DATETIME, RW_TIME, RW_FLOAT, RW_MONEY: DataType := ttFloat;
    End;
    { Calculate the position in the record buffer }
    BufferOffset := fRecordBufferSize;
    Case DataType Of
      ttstring:
        Begin
          DataSize := pDataSize;
          Inc(fRecordBufferSize, DataSize + (DataSize Mod SizeOf(Word)) + Sizeof(WordBool));
            // last boolean is the Null indicator
        End;
      ttFloat:
        Begin
          Inc(fRecordBufferSize, SizeOf(Double) + Sizeof(WordBool));
          DataSize := SizeOf(Double);
        End;
      ttInteger:
        Begin
          Inc(fRecordBufferSize, SizeOf(Integer) + Sizeof(WordBool));
          DataSize := SizeOf(Integer);
        End;
      ttBoolean:
        Begin
          Inc(fRecordBufferSize, SizeOf(WordBool) + Sizeof(WordBool));
          DataSize := SizeOf(WordBool);
        End;
    End;
  End;
End;

Function TResultSet.GetRecno: Integer;
Begin
  Result := fRecNo;
End;

Procedure TResultSet.SetRecno(Value: Integer);
Begin
  If fRecNo = Value Then Exit;
  If (Value < 1) Or (Value > GetRecordCount) Then
    Raise ExQueryError.Create(SRecnoInvalid);
  fRecNo := Value;
End;

Function TResultSet.GetRecordCount: Longint;
Begin
  Result := 0;
End;

Procedure TResultSet.SaveToText(Const FileName: String); // debugging purposes
Var
  I, J: Integer;
  f: TStringList;
  s: String;
Begin
  f := TStringList.Create;
  s := '';
  For J := 0 To Fields.Count - 1 Do
    s := s + Format('%12d', [J]);
  f.Add(s);
  For I := 1 To RecordCount Do
  Begin
    Recno := I;
    s := '';
    For J := 0 To Fields.Count - 1 Do
      s := s + Format('%12s', [Fields[J].Asstring]);
    f.Add(s);
  End;
  f.SaveToFile(FileName);
  f.free;
End;

{-------------------------------------------------------------------------------}
{                  Implements TMemResultSet                                     }
{-------------------------------------------------------------------------------}

Constructor TMemResultSet.Create;
Begin
  Inherited Create;
  fBufferList := TList.Create;
End;

Destructor TMemResultSet.Destroy;
Begin
  Clear;
  fBufferList.Free;
  Inherited Destroy;
End;

Procedure TMemResultSet.Clear;
Begin
  Inherited Clear;
  ClearBufferList;
End;

Procedure TMemResultSet.SortWithList(SortList: TxqSortList);
Var
  vTempList: TList;
  I: Integer;
Begin
  vTempList := TList.Create;
  For I := 1 To SortList.Count Do
  Begin
    SortList.Recno := I;
    vTempList.Add(fBufferList[SortList.SourceRecno - 1]);
  End;
  fBufferList.Free;
  fBufferList := vTempList;
End;

Procedure TMemResultSet.ClearBufferList;
Var
  I: Integer;
  Buffer: PChar;
  Bookmark: TBookmark;
Begin
  For I := 0 To fBufferList.Count - 1 Do
  Begin
    Buffer := fBufferList[I];
    { free the bookmark }
    Move((Buffer + 0)^, Bookmark, SizeOf(TBookmark));
    If (Longint(Bookmark) > 0) And (fSourceDataSet <> Nil) Then
    Begin
      fSourceDataSet.FreeBookmark(Bookmark);
    End;
    FreeMem(Buffer, fRecordBufferSize);
  End;
  fBufferList.Clear;
End;

Function TMemResultSet.ActiveBuffer: PChar;
Begin
  Result := Nil;
  If (fRecNo < 1) Or (fRecNo > fBufferList.Count) Then
    Exit;
  Result := fBufferList[fRecNo - 1];
End;

Function TMemResultSet.GetFieldData(Field: TxqField; Buffer: Pointer): Boolean;
Var
  RecBuf: PChar;
Begin
  Result := False;
  If GetIsNull(Field) Then Exit;
  RecBuf := ActiveBuffer;
  If RecBuf = Nil Then Exit;
  Move((RecBuf + Field.BufferOffset + SizeOf(WordBool))^, Buffer^, Field.DataSize);
  Result := True;
End;

Function TMemResultSet.GetIsNull(Field: TxqField): Boolean;
Var
  RecBuf: PChar;
  HasValue: WordBool;
Begin
  Result := False;
  RecBuf := ActiveBuffer;
  If RecBuf = Nil Then Exit;
  Move((RecBuf + Field.BufferOffset)^, HasValue, SizeOf(WordBool));
  Result := Not HasValue;
End;

{ LAS: 5/JUN/2002}
Procedure TMemResultSet.SetIsNull(Field: TxqField);
Var
  RecBuf: PChar;
  HasValue: WordBool;
Begin
  RecBuf := ActiveBuffer;
  If RecBuf = Nil Then Exit;
  HasValue:= False;
  Move(HasValue, (RecBuf + Field.BufferOffset)^, SizeOf(WordBool));
End;

Procedure TMemResultSet.SetFieldData(Field: TxqField; Buffer: Pointer);
Var
  RecBuf: PChar;
  HasValue: WordBool;
Begin
  RecBuf := ActiveBuffer;
  If (RecBuf = Nil) Or (Buffer = Nil) Then Exit;
  Move(Buffer^, (RecBuf + Field.BufferOffset + SizeOf(WordBool))^, Field.DataSize);
  HasValue := True;
  Move(HasValue, (RecBuf + Field.BufferOffset)^, SizeOf(WordBool));
End;

Function TMemResultSet.GetRecordCount;
Begin
  Result := fBufferList.Count;
End;

Procedure TMemResultSet.SetSourceBookmark(Bookmark: TBookmark);
Var
  Buffer: PChar;
Begin
  If (fRecNo < 1) Or (fRecNo > GetRecordCount) Then Exit;
  { first delete any previous bookmark set }
  FreeSourceBookmark;
  Buffer := PChar(fBufferList[fRecNo - 1]);
  Move(Bookmark, (Buffer + 0)^, SizeOf(TBookmark));
End;

Function TMemResultSet.GetSourceBookmark: TBookmark;
Var
  Buffer: PChar;
Begin
  Result := Nil;
  If (fRecNo < 1) Or (fRecNo > GetRecordCount) Then Exit;
  Buffer := PChar(fBufferList[fRecNo - 1]);
  Move((Buffer + 0)^, Result, SizeOf(TBookmark));
End;

Procedure TMemResultSet.FreeSourceBookmark;
Var
  Buffer: PChar;
  Bookmark: TBookmark;
Begin
  If (fRecNo < 1) Or (fRecNo > GetRecordCount) Then Exit;
  Buffer := PChar(fBufferList[fRecNo - 1]);
  Move((Buffer + 0)^, Bookmark, SizeOf(TBookmark));
  If (Longint(Bookmark) > 0) And (fSourceDataSet <> Nil) Then
  Begin
    fSourceDataSet.FreeBookmark(Bookmark);
  End;
  Bookmark := Nil;
  Move(Bookmark, (Buffer + 0)^, SizeOf(TBookmark));
End;

Procedure TMemResultSet.Insert;
Var
  Buffer: PChar;
Begin
  GetMem(Buffer, fRecordBufferSize);
  FillChar(Buffer^, fRecordBufferSize, 0);
  fBufferList.Add(Buffer);
  fRecNo := fBufferList.Count;
End;

Procedure TMemResultSet.Delete;
Var
  Buffer: PChar;
Begin
  If (fRecNo < 1) Or (RecNo > GetRecordCount) Then Exit;
  FreeSourceBookmark;
  Buffer := fBufferList[fRecNo - 1];
  FreeMem(Buffer, fRecordBufferSize);
  fBufferList.Delete(fRecNo - 1);
  If fRecNo > GetRecordCount Then
    fRecNo := GetRecordCount;
End;

{-------------------------------------------------------------------------------}
{                  Implements TFileResultSet                                    }
{-------------------------------------------------------------------------------}

Constructor TFileResultSet.Create(MapFileSize: Longint);
Begin
  Inherited Create;
  fBufferList := TList.Create;
  { auxiliary files }
  fTmpFile := GetTemporaryFileName('~xq');
  fMemMapFile := TMemMapFile.Create(fTmpFile, fmCreate, MapFileSize, True);
End;

Destructor TFileResultSet.Destroy;
Begin
  If Assigned(fBuffer) Then
    FreeMem(fBuffer, fRecordBufferSize);
  Clear;
  fBufferList.Free;
  Inherited Destroy;
End;

Procedure TFileResultSet.Clear;
Var
  I: Integer;
  Bookmark: TBookmark;
Begin
  Inherited Clear;
  { free the bookmarks }
  For I := 0 To FBufferList.Count - 1 Do
  Begin
    fMemMapFile.Seek(Longint(fBufferList[I]), 0);
    fMemMapFile.Read(Bookmark, SizeOf(TBookmark));
    If (Longint(Bookmark) > 0) And (fSourceDataSet <> Nil) Then
    Begin
      fSourceDataSet.FreeBookmark(Bookmark);
    End;
  End;
  FreeObject(fMemMapFile);
  SysUtils.DeleteFile(fTmpFile);
  fBufferList.Clear;
End;

Procedure TFileResultSet.SortWithList(SortList: TxqSortList);
Var
  vTempList: TList;
  I: Integer;
Begin
  vTempList := TList.Create;
  For I := 1 To SortList.Count Do
  Begin
    SortList.Recno := I;
    vTempList.Add(fBufferList[SortList.SourceRecno - 1]);
  End;
  fBufferList.Free;
  fBufferList := vTempList;
End;

Function TFileResultSet.ActiveBuffer: PChar;
Begin
  Result := Nil;
  If (fRecNo < 1) Or (fRecNo > fBufferList.Count) Then
    Exit;
  If Not Assigned(fBuffer) Then
    GetMem(fBuffer, fRecordBufferSize);
  fMemMapFile.Seek(Longint(fBufferList[fRecNo - 1]), 0);
  fMemMapFile.Read(fBuffer^, fRecordBufferSize);
  Result := fBuffer;
End;

Function TFileResultSet.GetFieldData(Field: TxqField; Buffer: Pointer): Boolean;
Var
  RecBuf: PChar;
Begin
  Result := False;
  If GetIsNull(Field) Then Exit;
  RecBuf := ActiveBuffer;
  If RecBuf = Nil Then
    Exit;
  Move((RecBuf + Field.BufferOffset + Sizeof(WordBool))^, Buffer^, Field.DataSize);
  Result := True;
End;

Function TFileResultSet.GetIsNull(Field: TxqField): Boolean;
Var
  RecBuf: PChar;
  HasValue: WordBool;
Begin
  Result := False;
  RecBuf := ActiveBuffer;
  If RecBuf = Nil Then
    Exit;
  Move((RecBuf + Field.BufferOffset)^, HasValue, SizeOf(WordBool));
  Result := Not HasValue;
End;

{ LAS : 5/JUN/2002 }
Procedure TFileResultSet.SetIsNull(Field: TxqField);
Var
  RecBuf: PChar;
  HasValue: WordBool;
Begin
  RecBuf := ActiveBuffer;
  If RecBuf = Nil Then Exit;
  HasValue:= False;
  Move(HasValue, (RecBuf + Field.Buffer