TStringsDataset, help needed
lazarus / 63-Database

----------------------------------------------------------------------
jc99 · 2015-07-07 23:08

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.Field
Name]);
    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 · 2015-07-08 05:24

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 · 2015-07-08 06:40

Quote from: LacaK on July 08, 2015, 07:24:58 amAt 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 · 2015-07-08 07:34

Quote from: jc99 on July 08, 2015, 08:40:23 amI'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
QuoteEOF 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:
Quote2. The record is on the last record, and the TDataset.Next method
is called.and also:
QuoteIt 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 · 2015-07-08 09:10

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 · 2015-07-08 10:57

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 · 2015-07-08 11:45

Quote from: rvk on July 08, 2015, 12:57:10 pmThat 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 · 2015-07-08 11:57

Quote from: taazz on July 08, 2015, 01:45:34 pmQuote from: rvk on July
08, 2015, 12:57:10 pmThat 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.

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

----------------------------------------------------------------------
jc99 · 2015-07-08 19:42

Quote from: rvk on July 08, 2015, 12:57:10 pmI 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 · 2015-07-08 19:52

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 · 2015-07-09 05:32

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 · 2015-07-09 20:59

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;