JSON turn Clientdataset

This is the code for a JSON clientdataset and Clientdataset to JSON on the web. There is a small bug

else I: = i + 2;

Causes when processing in Chinese. Parsing errors

The right one should be

else I: = i + 1;

Chinese Unicode is double-byte. The value of I is originally 1, plus 2 is 3 bytes. Causes the old error when the JSON of the Chinese character is cut.

Hope to be useful to everyone

----------------------------------------------------------------------------------

Unit jsondb;

Interface
Uses
Sysutils, Classes, variants, DB, Dbclient, Superobject, Dialogs;
Type
TJSONDB = Class

Private
class function Getjsonfieldnames (res:isuperobject): tstringlist;
class function Getjsonfieldvalues (res:isuperobject): tstringlist;
Public
Class procedure Jsontoclientdataset (Jsonarr:tsuperarray; dstcds:tclientdataset);
class function Clientdatasettojson (Srccds:tclientdataset): utf8string;
End

Implementation

function GetToken (var astring:string; const Fmt:array of Char): string;
Var
I,j:integer;
Found:boolean;
Begin
Found: = false;
Result: = ';
Astring: = Trimleft (astring);

If Length (astring) = 0 Then exit;

I: = 1;
While I <= length (astring) does
Begin
Found: = false;
If Astring[i] <= #128 Then
Begin
For j: = Low (FMT)-to-high (FMT) does
Begin
if (Astring[i] <> fmt[j]) then continue;
Found: = true;
Break
End
If not found then I: = I + 1;
End
else I: = i + 2;

If found then break;
End

If found then
Begin
Result: = Copy (astring, 1, i-1);
Delete (astring, 1, i);
End
Else
Begin
Result: = astring;
Astring: = ";
End
End

function Getfieldparams (propname, source:string): string;
Var
S1, s2:string;
tmpparam:string;
achar:string;
Avalue, Apropname, asource:string;
Begin
Result: = ';
If Source = ' then Exit ';
Asource: = Source;
While Asource <> "do
Begin
Avalue: = GetToken (Asource, [', ']);
Apropname: = GetToken (Avalue, [': ']);
If Comparetext (propname, Apropname) <> 0 then continue;
Result: = Avalue;
Break
End
End

Get linked fields bit name from JSON

class function Tjsondb.getjsonfieldnames (res:isuperobject): tstringlist;
Var
I:integer;
Fieldlist:tstringlist;
fieldnames:string;
Begin
Try
FieldList: = tstringlist.create;
FieldNames: = Res. AsObject.getNames.AsString;
FieldNames: = StringReplace (FieldNames, ' [', ', ', [Rfreplaceall, Rfignorecase]);
FieldNames: = StringReplace (FieldNames, '] ', "', [Rfreplaceall, Rfignorecase]);
FieldNames: = StringReplace (FieldNames, ' "', '", [Rfreplaceall, Rfignorecase]);

Fieldlist.delimiter: = ', ';
Fieldlist.delimitedtext: = FieldNames;
Result: = FieldList;
Finally
Fieldlist.free;
End
End

Get linked fields bit value from JSON

class function Tjsondb.getjsonfieldvalues (res:isuperobject): tstringlist;
Var
I:integer;
Fieldlist:tstringlist;
fieldvalues:string;
Begin
Try
FieldList: = tstringlist.create;
Fieldvalues: = Res. AsObject.getValues.AsString;
Fieldvalues: = StringReplace (Fieldvalues, ' [', ', ', [Rfreplaceall, Rfignorecase]);
Fieldvalues: = StringReplace (fieldvalues, '] ', "', [Rfreplaceall, Rfignorecase]);
Fieldvalues: = StringReplace (Fieldvalues, ' "', '", [Rfreplaceall, Rfignorecase]);

Fieldlist.delimiter: = ', ';
Fieldlist.delimitedtext: = fieldvalues;
Result: = FieldList;
Finally
Fieldlist.free;
End
End

JSON conversion CDs

Class procedure tjsondb. Jsontoclientdataset (Jsonarr:tsuperarray; dstcds:tclientdataset);
Var
Fieldlist:tstringlist;
Valueslist:tstringlist;
jsonsrc:string;
I, J:integer;
Begin
FieldList: = Getjsonfieldnames (So[jsonarr[0]. Asjson (False, false)]);
if (dstcds.fieldcount = 0) Then
Begin
For I: = 0 to Fieldlist.count-1 do
Begin
DSTCDS.FIELDDEFS.ADD (Fieldlist[i], ftstring, N, False);
End
Dstcds.createdataset;
Dstcds.close;
Dstcds.open;
End
Try
Dstcds.disablecontrols;
For I: = 0 to Jsonarr.length-1 do
Begin
JSONSRC: = So[jsonarr[i]. Asjson (False, false)]. asstring;
JSONSRC: = StringReplace (Jsonsrc, ' [', ', ', [Rfreplaceall, Rfignorecase]);
JSONSRC: = StringReplace (jsonsrc, '] ', "', [Rfreplaceall, Rfignorecase]);
JSONSRC: = StringReplace (Jsonsrc, ' "', '", [Rfreplaceall, Rfignorecase]);
JSONSRC: = StringReplace (Jsonsrc, ' {', ', ', [Rfreplaceall, Rfignorecase]);
JSONSRC: = StringReplace (jsonsrc, '} ', ', [Rfreplaceall, Rfignorecase]);
Dstcds.append;
For J: = 0 to Fieldlist.count-1 do
Begin
Dstcds.fieldbyname (Fieldlist[j]). Asstring: = Getfieldparams (Fieldlist[j], jsonsrc);
End
Dstcds.post;
End
Finally
Dstcds.enablecontrols;
End
End

Clientdataset JSON

class function Tjsondb. Clientdatasettojson (Srccds:tclientdataset): utf8string;
Var
I, J:integer;
keyvalue:string;
Jsonlist:tstringlist;
jsonresult:string;
Begin
If not srccds.active then Srccds.open;
Try
Jsonlist: = tstringlist.create;
Srccds.disablecontrols;
Srccds.first;
While not srccds.eof do
Begin
KeyValue: = ";
For I: = 0 to Srccds.fielddefs.count-1 do
Begin
KeyValue: = KeyValue + Format (' "%s": "%s", ', [srccds.fields[i]. FieldName, Srccds.fields[i]. Asstring]);

End
Jsonlist.add (Format (' {%s} ', [Copy (KeyValue, 0, Length (keyValue)-1)]);
Srccds.next;
End
For I: = 0 to Jsonlist.count-1 do
Begin
Jsonresult: = Jsonresult + jsonlist[i] + ', ';
End
Result: = Utf8encode (Format (' [%s] ', [Copy (Jsonresult, 0, Length (jsonresult)-1)]);
Finally
Srccds.enablecontrols;
Jsonlist.free;
End
End

End.