paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 09:49:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Example for JSON dataset

Browse Source 
git-svn-id: trunk@19857 -
This commit is contained in:
michael 2011-12-16 16:31:13 +00:00
parent b4cc174cd7
commit 9135ece182
3 changed files with 237 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -1997,12 +1997,14 @@ packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
packages/fcl-db/tests/tcsqlscanner.pas svneol=native#text/plain
packages/fcl-db/tests/test.json svneol=native#text/plain
packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
packages/fcl-db/tests/testbufdatasetstreams.pas svneol=native#text/plain
packages/fcl-db/tests/testdatasources.pas svneol=native#text/plain
packages/fcl-db/tests/testdbbasics.pas svneol=native#text/plain
packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain
packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain

43
packages/fcl-db/tests/test.json Normal file
View File

@ -0,0 +1,43 @@
{
"metaData" : {
"fields" : [
{
"name" : "ID",
"type" : "int"
},
{
"name" : "Name",
"type" : "string",
"maxlen" : 20
},
{
"name" : "Email",
"type" : "string",
"maxlen" : 30
}
],
"root" : "rows"
},
"rows" : [
{
"ID" : 3,
"Name" : "Michael",
"Email" : "michael@freepascal.org"
},
{
"ID" : 4,
"Name" : "jonas",
"Email" : "jonas@freepascal.org"
},
{
"ID" : 1,
"Name" : "Florian",
"Email" : "Florian@freepascal.org"
},
{
"ID" : 12,
"Name" : "Marco",
"Email" : "Marco@stack.nl"
}
]
}

192
packages/fcl-db/tests/testjsondataset.pp Normal file
View File

@ -0,0 +1,192 @@
program testjsondataset;
{$mode objfpc}{$H+}
uses
Classes, sysutils, DB, jsondataset, fpjson, jsonparser;
{$R *.res}
Function ExtractData(Const AFileName : string) : TJSONObject;
Var
F : TFIleStream;
P : TJSONParser;
D : TJSONData;
begin
Result:=Nil;
F:=TFileStream.Create(AFileName,fmOpenRead);
try
P:=TJSONParser.Create(F);
try
D:=P.Parse;
if (D.JSONType=jtObject) then
Result:=D as TJSONObject
else
FreeAndNil(D);
finally
P.Free;
end;
finally
F.Free;
end;
end;
Procedure DumpDataset(DS : TDataset);
Var
I,J : Integer;
begin
I:=0;
Writeln('Dataset contains ',DS.RecordCount,' records');
While not DS.EOF do
begin
Inc(I);
Writeln('=== Record ',I,' : ',DS.RecNo,' ===');
For J:=0 to DS.Fields.Count-1 do
With DS.Fields[J] do
Writeln(FieldName,' : ',AsString);
DS.Next;
end;
Writeln('Dataset contained ',I,' records');
end;
Procedure DoTest4(Const AFileName : string);
Var
DS : TExtjsJSONObjectDataset;
begin
DS:=TExtjsJSONObjectDataset.Create(Nil);
try
DS.LoadFromFile(AFileName);
DS.Open;
DumpDataset(DS);
finally
DS.Free;
end;
end;
Procedure DoTest1(Const AFileName : string);
Var
D,M : TJSONObject;
DS : TExtjsJSONObjectDataset;
I,J : Integer;
F : TFieldDef;
begin
D:=ExtractData(AFileName);
try
DS:=TExtjsJSONObjectDataset.Create(Nil);
try
DS.Rows:=D.Arrays['rows'];
DS.Metadata:=D.Objects['metaData'];
DS.OwnsData:=False;
DS.Open;
For I:=0 to DS.FieldDefs.Count-1 do
begin
F:=DS.FieldDefs[i];
Writeln('FieldDefs.Add(''',F.Name,''',',F.DataType,',',F.Size,');');
end;
DumpDataset(DS);
finally
DS.Free;
end;
finally
D.Free;
end;
end;
Procedure DoTest2(Const AFileName : string);
Var
D,M : TJSONObject;
DS : TExtjsJSONObjectDataset;
I,J : Integer;
F : TFieldDef;
begin
D:=ExtractData(AFileName);
DS:=TExtjsJSONObjectDataset.Create(Nil);
DS.Rows:=D.Arrays['rows'];
With DS do
begin
FieldDefs.Add('ID',ftLargeint,0);
FieldDefs.Add('Name',ftString,20);
FieldDefs.Add('Email',ftString,30);
end;
DS.Open;
DumpDataset(DS);
end;
Procedure DoTest3(Const AFileName : string);
Var
DS : TExtjsJSONObjectDataset;
I,J : Integer;
F : TFieldDef;
begin
DS:=TExtjsJSONObjectDataset.Create(Nil);
try
With DS do
begin
FieldDefs.Add('ID',ftLargeint,0);
FieldDefs.Add('Name',ftString,20);
FieldDefs.Add('Email',ftString,30);
Open;
// Record 1
Append;
FieldByName('ID').AsInteger:=3;
FieldByName('Name').AsString:='Michael';
FieldByName('Email').AsString:='michael@freepascal.org';
Post;
// Record 2
Append;
FieldByName('ID').AsInteger:=4;
FieldByName('Name').AsString:='jonas';
FieldByName('Email').AsString:='jonas@freepascal.org';
Post;
DumpDataset(DS);
First;
// insert record 1
Insert;
FieldByName('ID').AsInteger:=1;
FieldByName('Name').AsString:='Florian';
FieldByName('Email').AsString:='Florian@freepascal.org';
Post;
DumpDataset(DS);
Writeln('First');
First;
Writeln('Editing record ', RecNo,' ',FieldByName('Name').AsString);
Edit;
FieldByName('ID').AsInteger:=12;
FieldByName('Name').AsString:='Marco';
FieldByName('Email').AsString:='Marco@stack.nl';
Post;
First;
DumpDataset(DS);
First;
Next;
Writeln('Deleting record ', RecNo,' ',FieldByName('Name').AsString);
Delete;
First;
DumpDataset(DS);
SaveToFile(AFileName,True);
end;
finally
DS.Free
end;
end;
begin
Writeln('Test 1');
DoTest1('test.json');
Writeln('Test 2');
DoTest2('test.json');
Writeln('Test 3');
DoTest3('test3.json');
Writeln('Test 4');
DoTest4('test.json');
end.