TStringsDataset, help needed

[jc99]

This is something for the DB-Gurus:
I am working on a TDataset -Descendent that stores the information in a TStrings-Component.
at the moment, it looks like this:

Code: [Select]

UNIT Cmp_TStringsDataSet;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

INTERFACE

USES
{$IFnDEF FPC}
  DSIntf,
{$ELSE}
{$ENDIF}
  SysUtils, Classes, DB;

TYPE

 { TStringsDataSet }

 TStringsDataSet = CLASS(TDataSet)
  Private
    { Private-Deklarationen }
    FStrings: TStrings;
    Fopened: Boolean;

  Protected
    { Protected-Deklarationen }
    function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; Override;
    procedure InternalFirst; override;
    PROCEDURE InternalClose; Override;
    PROCEDURE InternalHandleException; Override;
    PROCEDURE InternalInitFieldDefs; Override;
    PROCEDURE InternalOpen; Override;
    FUNCTION IsCursorOpen: Boolean; Override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; Override;
    procedure SetFieldData(Field: TField; Buffer: Pointer); Override;

    // Optional.
    function GetRecordCount: Integer; override;

  Public
    { Public-Deklarationen }
  Published
    { Published-Deklarationen }
    PROPERTY Source: TStrings Read FStrings Write FStrings;
  END;

PROCEDURE Register;

IMPLEMENTATION

USES variants;

PROCEDURE Register;
BEGIN
  RegisterComponents('Data Access', [TStringsDataSet]);
END;

function TStringsDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
BEGIN
   //
  result := grEOF;
END;

procedure TStringsDataSet.InternalFirst;
begin
  //
end;

procedure TStringsDataSet.InternalClose;
BEGIN
  //
END;

procedure TStringsDataSet.InternalHandleException;
BEGIN
  //
END;

procedure TStringsDataSet.InternalInitFieldDefs;
VAR
  I: Integer;
  Fieldnm: ansistring;
  Val: Variant;
  f: TField;
  n: integer;
  r: Extended;
  FieldID: Integer;
  {$IFNDEF FPC}
  FldDesc: DSFLDDesc;
  {$ENDIF}
  iFldType: TFieldType;
  iFldSize: Integer;


BEGIN
  //
  FieldDefs.Clear;
  FOR I := 0 TO Fstrings.Count - 1 DO
    try
      Fieldnm := fstrings.Names[i];
      val := FStrings.ValueFromIndex[i];
//      WITH FldDesc DO
        try
        //  strcopy(pansiChar(@szName) , @fieldnm[1]);
          IF (lowercase(val) = 'true') OR (Lowercase(val) = 'false') THEN
            BEGIN
          // Boolean field;

              iFldType := ftBoolean;
              iFldSize := 0;
             // iFldSubType := fldstBINARY;
            END
          ELSE IF TryStrToInt(val, n) THEN
          begin
              iFldType := ftInteger;
              iFldSize := 0;
             // iFldSubType := fldstBINARY;
            END
          ELSE IF TryStrToFloat(val, r) THEN
            BEGIN
              iFldType := ftFloat ;
              iFldSize := 0;
             // iFldSubType := fldstBINARY;
            END
          ELSE
            BEGIN
              iFldType:= ftString;
              iFldSize := 100;
            END;
        finally
        END;
      {$IFNDEF FPC}
      AddFieldDesc(fldDesc, i,Fielddefs);
      {$ELSE}
      TFieldDef.Create(FieldDefs,Fieldnm,iFldType,iFldSize,false,I+1);
      {$ENDIF}
    finally
    END;
  Fopened := true;
END;

procedure TStringsDataSet.InternalOpen;

BEGIN
  //
  internalinitFielddefs;
  CreateFields;
END;

function TStringsDataSet.IsCursorOpen: Boolean;
BEGIN
  //
  result := Fopened;
END;

function TStringsDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  I: Integer;
  aStr:string;
begin
  I:= Field.FieldNo - 1;
  if assigned(Buffer) then // [EDIT2]
   begin
  case Field.DataType of
    ftBoolean:wordbool(Buffer^):=StrToBool(FStrings.Values[Field.FieldName]);
    ftinteger:LongInt(Buffer^):=25; // Todo:
    ftFloat:double(Buffer^):=pi;  // Todo:
    ftString:begin
      aStr :=  FStrings.Values[Field.FieldName];
      move(aStr[1],Buffer^,length(aStr)+1);
    end;
  end;
  result := true; // <-------
  end;
end;

procedure TStringsDataSet.SetFieldData(Field: TField; Buffer: Pointer);
begin
//  FStrings.Values[Field.FieldName]:=Field.value;

  inherited SetFieldData(Field, Buffer);
  if assigned(Buffer) then
  case Field.DataType of
    ftBoolean:FStrings.Values[Field.FieldName]:=BoolToStr( wordbool(Buffer^),true);
// [EDIT]:
    ftFloat: FStrings.Values[Field.FieldName]:=FloatToStr( double(Buffer^));
    ftInteger: FStrings.Values[Field.FieldName]:=IntToStr( integer(Buffer^));
    ftstring:FStrings.Values[Field.FieldName]:= PChar( Buffer);
  end;
end;

function TStringsDataSet.GetRecordCount: Integer;
begin
  Result:=inherited GetRecordCount;
end;

END.
It Works, that i can enter text, and set the Boolean , Both are written in the TString ,
But nothing comes out.
Here I need help.
I think the problem lies in the
TStringsDataSet.GetFieldData - Function
Any help is welcome.

[LacaK]

At least TStringsDataSet.GetRecord seems suspicious. It always returns grEof, so it signals to TDataSet that there are no records in underlaying "data storage".

[jc99]

At least TStringsDataSet.GetRecord seems suspicious. It always returns grEof, so it signals to TDataSet that there are no records in underlaying "data storage".

Thanks LacaK,
I'm going to look into this, as I understand it grEof has to be send with the last record, My dataset has only one therefor i sent it all the time. (But that's maybe not correct)
I found another mistake:
  the result of  GetFieldData  was not set, with it (See [Edit2])
  it starts to work:

BTW should I update the code in the first post, or make a new one/a reply ?

[rvk]

I'm going to look into this, as I understand it grEof has to be send with the last record, My dataset has only one therefor i sent it all the time. (But that's maybe not correct)

Looking at a normal loop you'll see that's not true:

Code: [Select]

dataset.First;
while dataset.Eof do
begin
  // do something
  dataset.Next;
end;
If with First the Eof was set you wouldn't enter the loop.
And if with the last record (after next) the Eof was set you wouldn't process the last record.

I do understand the confusion.
According to this: http://lazarus-ccr.sourceforge.net/docs/fcl/db/tdataset.eof.html

EOF is True if the cursor is on the last record in the dataset, and no more records are available

But in the cases after it it says:

2. The record is on the last record, and the TDataset.Next method is called.

and also:

It is only when the cursor is on the last record and Next is called, that EOF will become True. This means that the following loop will stop after the last record was visited

Edit: I think normally you would post new code in a new post. Otherwise the discussion (and pointers) you get would mean nothing when reading the code from the first post. If I wanted to look at the old code where you set grEof I wouldn't find it anymore so I couldn't see what you did "wrong".

[jc99]

Thanks rvk,
I'll try to implement this, as soon as I have time, I'm on a buissnes/Service tripp abroad. Any code-suggestions are welcome.

[rvk]

I was just about to try using a TDataset-like descendant for accessing Google calendar and GMail after creating a OAuth2.0 library for the Google apis (for .Next/Prior etc) (see here).

What I did notice about your code is that you have GetFieldData and SetFieldData in the protected section of your descendant. I think you should have gotten an compiler warning saying that the visibility of those method is lower than in TDataSet (which is in public).

Code: [Select]

Note: Virtual method "GetFieldData(TField;Pointer):Boolean;" has a lower visibility (protected) than parent class TDataSet (public)
Note: Virtual method "SetFieldData(TField;Pointer);" has a lower visibility (protected) than parent class TDataSet (public)

That would mean that your GetFieldData and SetFieldData are never called. Move them to public and see if it works better.

[taazz]

That would mean that your GetFieldData and SetFieldData are never called. Move them to public and see if it works better.

Erm no it doesn't. Lowering visibility is not supported as far as I know even if it was supported how do you think the protected virtual method work in the first place? The warning you see is a simple "FYI the visibility is not what you defined here" message and nothing else.

[rvk]

That would mean that your GetFieldData and SetFieldData are never called. Move them to public and see if it works better.

Erm no it doesn't. Lowering visibility is not supported as far as I know even if it was supported how do you think the protected virtual method work in the first place? The warning you see is a simple "FYI the visibility is not what you defined here" message and nothing else.

Woops... my bad ("lack of knowledge"  )

I was under the impression the lower visibility would also mean the original public method of the base-class would still be called (and not the newer protected method). I was wrong.
 

In practice this is never harmful, but it can be confusing to someone reading documentation and observing the visibility attributes of the document.

(Source)

[jc99]

I was just about to try using a TDataset-like descendant for accessing Google calendar and GMail after creating a OAuth2.0 library for the Google apis (for .Next/Prior etc) (see here).

What I did notice about your code is that you have GetFieldData and SetFieldData in the protected section of your descendant. I think you should have gotten an compiler warning saying that the visibility of those method is lower than in TDataSet (which is in public).

Code: [Select]

Note: Virtual method "GetFieldData(TField;Pointer):Boolean;" has a lower visibility (protected) than parent class TDataSet (public)
Note: Virtual method "SetFieldData(TField;Pointer);" has a lower visibility (protected) than parent class TDataSet (public)

That would mean that your GetFieldData and SetFieldData are never called. Move them to public and see if it works better.

I used TMemDataset as a Template,
And in memds.pas (line 85 ,91 & 109 ) you see that they also lower the visibility of these Methods.
however in  TCustomBufDataset (BufDataset Line 512, 516 ff ) these methods are public.

[rvk]

Do you also have some small test-program.

I tried your source with the following and it worked.

Code: [Select]

a=test
b=ok
became

Code: [Select]

a=test
b=ccccc


Code: [Select]

procedure TForm1.Button1Click(Sender: TObject);
begin
    ds.Edit;
    ds.FieldByName('b').asString := 'ccccc';
    ds.Post;
    Showmessage(ds.Source.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Add('a=test');
  sl.Add('b=ok');
  ds := TStringsDataSet.Create(Self);
  ds.Source := sl;
  ds.Open;
  DataSource1.DataSet := ds;
end;

What exactly is going wrong at your end?

[jc99]

First I needed the Ds to update when the SL is updated
So:

Code: [Select]

  Published
    { Published-Deklarationen }
    PROPERTY Source: TStrings Read FStrings Write SetStrings;

procedure TStringsDataSet.SetStrings(AValue: TStrings);
begin
  if FStrings=AValue then Exit;
  FStrings:=AValue;
  if Fstrings.InheritsFrom(TStringList) then
    TStringList(FStrings).OnChange:=StringListOnChange;
end;

Then DBGrid should work properly:
Thanks to your suggestion i updated:

Code: [Select]

  Private
    { Private-Deklarationen }
    FStrings: TStrings;
    Fopened: Boolean;
    FCurrendDS :integer;
    FChanging : boolean;

[...]
function TStringsDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
BEGIN
  Result:=grOk;
    case GetMode of
      gmCurrent:
        if (FCurrendDS>=1) or (FCurrendDS<0) then
          Result:=grError;
      gmNext:
        if (FCurrendDS<0) then
          Inc(FCurrendDS)
        else
          Result:=grEOF;
      gmPrior:
        if (FCurrendDS>0) then
          Dec(FCurrendDS)
        else
          result:=grBOF;
    end;
END;

procedure TStringsDataSet.InternalFirst;
begin
  FCurrendDS:=0;
end;
[...]
procedure TStringsDataSet.InternalOpen;

BEGIN
  //
  internalinitFielddefs;
  CreateFields;
  FCurrendDS:=-1;
END;
[...]


procedure TStringsDataSet.SetFieldData(Field: TField; Buffer: Pointer);
begin
//  FStrings.Values[Field.FieldName]:=Field.value;
  FChanging := true;
  try
  inherited SetFieldData(Field, Buffer);
  if assigned(Buffer) then
  case Field.DataType of
    ftBoolean:FStrings.Values[Field.FieldName]:=BoolToStr( wordbool(Buffer^),true);
    ftFloat: FStrings.Values[Field.FieldName]:=FloatToStr( double(Buffer^));
    ftInteger: FStrings.Values[Field.FieldName]:=IntToStr( longint(Buffer^));
    ftstring:FStrings.Values[Field.FieldName]:= PChar( Buffer);
  end;
  finally
    Fchanging:= false;
  end;
end;

procedure TStringsDataSet.StringListOnChange(Sender: Tobject);
begin
  try
  if not FChanging then
    Refresh;
  except

  end;
end;
I Hope i didn't forget something
... maybe more comes later

I know i have to do a saver String to XXX - Conversion.

after the post everything seems to work,
but when editing i have a small update-problem.

[jc99]

Solved the Update-Problem & did a saver string to anything conversion

Code: [Select]

function TStringsDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  aStr:string;
  lInteger: integer;
  lBool: Boolean;
  lFloat: Double;
begin
  if assigned(Buffer) then
    begin
  case Field.DataType of
    ftBoolean:
      if TryStrToBool(FStrings.Values[Field.FieldName],lBool) then
        wordbool(Buffer^):= lBool;
    ftinteger:if TryStrToint(FStrings.Values[Field.FieldName],lInteger) then
        LongInt(Buffer^):= lInteger;
    ftFloat:if TryStrToFloat(FStrings.Values[Field.FieldName],lFloat,FFs) then
        double(Buffer^):=lFloat;
    ftString:begin
      aStr :=  FStrings.Values[Field.FieldName];
      if length(astr) > 0 then
      move(aStr[1],Buffer^,length(aStr)+1)
      else
        byte(Buffer^):=0;
    end;
  end;
  result := true;
    end;
end;

procedure TStringsDataSet.SetFieldData(Field: TField; Buffer: Pointer);

begin
//  FStrings.Values[Field.FieldName]:=Field.value;
  FChanging := true;
  try
  inherited SetFieldData(Field, Buffer);
  if assigned(Buffer) then
  case Field.DataType of
    ftBoolean:FStrings.Values[Field.FieldName]:=BoolToStr( wordbool(Buffer^),true);
    ftFloat: FStrings.Values[Field.FieldName]:=FloatToStr( double(Buffer^),Ffs);
    ftInteger: FStrings.Values[Field.FieldName]:=IntToStr( longint(Buffer^));
    ftstring:FStrings.Values[Field.FieldName]:= PChar( Buffer);
  end;
  finally
    Fchanging:= false;
  end;
  if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
   DataEvent(deFieldChange, PtrInt(Field));

end;