TStringsDataset, help needed

Forum > Database

(1/3) > >>

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: ---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.

--- End code ---
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:

--- Quote from: LacaK on July 08, 2015, 07:24:58 am ---At least TStringsDataSet.GetRecord seems suspicious. It always returns grEof, so it signals to TDataSet that there are no records in underlaying "data storage".

--- End quote ---
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:

--- Quote from: jc99 on July 08, 2015, 08:40:23 am ---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)

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

--- Code: ---dataset.First;
while dataset.Eof do
begin
// do something
dataset.Next;
end;

--- End code ---
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

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

--- End quote ---
But in the cases after it it says:

--- Quote ---2. The record is on the last record, and the TDataset.Next method is called.
--- End quote ---
and also:

--- Quote ---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
--- End quote ---

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.

Navigation

[0] Message Index

[#] Next page