JSON利用superobject进行资料交换及重新封装ClientDataSet

先下载superobject   http://code.google.com/p/superobject/downloads/list

 

001.

unit uJSONDB;

002.

 

003.

interface

004.

uses

005.

SysUtils,Classes,Variants,DB,DBClient,SuperObject,Dialogs;

006.

type

007.

TJSONDB =

class

008.

 

009.

private

010.

class

function

getJsonFieldNames(res: ISuperObject):TStringList ;

011.

class

function

getJsonFieldValues(res: ISuperObject):TStringList ;

012.

public

013.

class

procedure JsonToClientDataSet(jsonArr: TSuperArray;dstCDS: TClientDataSet);

014.

class

function

ClientDataSetToJSON(srcCDS: TClientDataSet):UTF8String;

015.

end;

016.

 

017.

implementation

018.

 

019.

function

GetToken(

var

astring: string;

const

fmt:array of

char

): string;

020.

var

021.

i,j:integer;

022.

Found:Boolean;

023.

begin

024.

found:=

false

;

025.

result:=

''

;

026.

aString := TrimLeft(aString);

027.

 

028.

if

length(astring)=0 then exit;

029.

 

030.

I:=1;

031.

while

I<=length(Astring)

do

032.

begin

033.

found:=

false

;

034.

if

aString[i]<=

#128 then

035.

begin

036.

for

j:=Low(Fmt) to High(Fmt)

do

037.

begin

038.

if

(astring[i]<>Fmt[j])  then

continue

;

039.

found:=

true

;

040.

break

;

041.

end;

042.

16456
             

if

Not found thenI:=I+1;

043.

end

044.

else

I:=I+2;

045.

 

046.

if

found then

break

;

047.

end;

048.

 

049.

if

found then

050.

begin

051.

result:=copy(astring,1,i-1);

052.

delete

(astring,1,i);

053.

end

054.

else

055.

begin

056.

result:=astring;

057.

astring:=

''

;

058.

end;

059.

end;

060.

 

061.

function

GetFieldParams(PropName,Source:string): string;

062.

var

063.

S1,S2: string;

064.

TmpParam: string;

065.

AChar: string;

066.

aValue,aPropName,aSource: string;

067.

begin

068.

Result:=

''

;

069.

if

Source=

''

then Exit;

070.

aSource := Source;

071.

while

aSource <>

''

do

072.

begin

073.

aValue := GetToken(aSource,[

','

]);

074.

aPropName := GetToken(aValue,[

':'

]);

075.

if

CompareText(PropName,aPropName) <>0 then

continue

;

076.

Result := aValue;

077.

break

;

078.

end;

079.

end;

080.

//从json取得字段名称

081.

class

function

TJSONDB.getJsonFieldNames(res: ISuperObject):TStringList ;

082.

var

083.

i: Integer;

084.

fieldList : TStringList;

085.

fieldNames :String;

086.

begin

087.

try

088.

fieldList := TStringList.Create;

089.

fieldNames := res.AsObject.getNames.AsString;

090.

fieldNames := StringReplace(fieldNames,

'['

,

''

,[rfReplaceAll,rfIgnoreCase]);

091.

fieldNames := StringReplace(fieldNames,

']'

,

''

,[rfReplaceAll,rfIgnoreCase]);

092.

fieldNames := StringReplace(fieldNames,

'"'

,

''

,[rfReplaceAll,rfIgnoreCase]);

093.

 

094.

fieldList.Delimiter :=

','

;

095.

fieldList.DelimitedText := fieldNames;

096.

Result:= fieldList;

097.

finally

098.

//fieldList.Free;

099.

end;

100.

end;

101.

 

102.

//从json取得字段值

103.

class

function

TJSONDB.getJsonFieldValues(res: ISuperObject):TStringList ;

104.

var

105.

i: Integer;

106.

fieldList : TStringList;

107.

fieldValues :String;

108.

begin

109.

try

110.

fieldList := TStringList.Create;

111.

fieldValues := res.AsObject.getValues.AsString;

112.

fieldValues := StringReplace(fieldValues,

'['

,

''

,[rfReplaceAll,rfIgnoreCase]);

113.

fieldValues := StringReplace(fieldValues,

']'

,

''

,[rfReplaceAll,rfIgnoreCase]);

114.

fieldValues := StringReplace(fieldValues,

'"'

,

''

,[rfReplaceAll,rfIgnoreCase]);

115.

 

116.

fieldList.Delimiter :=

','

;

117.

fieldList.DelimitedText := fieldValues;

118.

Result:= fieldList;

119.

finally

120.

//fieldList.Free;

121.

end;

122.

end;

123.

//json转CDS

124.

class

procedure TJSONDB.JsonToClientDataSet(jsonArr: TSuperArray;dstCDS: TClientDataSet);

125.

var

126.

fieldList: TStringList;

127.

valuesList: TStringList;

128.

jsonSrc: string;

129.

i,j: Integer;

130.

begin

131.

 

132.

fieldList:= getJsonFieldNames(SO[jsonArr[0].AsJson(False,False)]);

133.

if

(dstCDS.FieldCount = 0) then

134.

begin

135.

for

i := 0 to fieldList.Count -1

do

136.

begin

137.

dstCDS.FieldDefs.Add(fieldList[i],ftString,100,False);

138.

end;

139.

dstCDS.CreateDataSet;

140.

dstCDS.Close;

141.

dstCDS.Open;

142.

end;

143.

try

144.

dstCDS.DisableControls;

145.

for

i := 0 to jsonArr.Length -1

do

146.

begin

147.

jsonSrc:= SO[jsonArr[i].AsJson(False,False)].AsString;

148.

jsonSrc := StringReplace(jsonSrc,

'['

,

''

,[rfReplaceAll,rfIgnoreCase]);

149.

jsonSrc := StringReplace(jsonSrc,

']'

,

''

,[rfReplaceAll,rfIgnoreCase]);

150.

jsonSrc := StringReplace(jsonSrc,

'"'

,

''

,[rfReplaceAll,rfIgnoreCase]);

151.

jsonSrc := StringReplace(jsonSrc,

'{'

,

''

,[rfReplaceAll,rfIgnoreCase]);

152.

jsonSrc := StringReplace(jsonSrc,

'}'

,

''

,[rfReplaceAll,rfIgnoreCase]);

153.

dstCDS.Append;

154.

for

j:= 0 to fieldList.Count -1

do

155.

begin

156.

dstCDS.FieldByName(fieldList[j]).AsString:= GetFieldParams(fieldList[j],jsonSrc);

157.

end;

158.

dstCDS.Post;

159.

end;

160.

 

161.

finally

162.

dstCDS.EnableControls;

163.

end;

164.

end;

165.

 

166.

class

function

TJSONDB.ClientDataSetToJSON(srcCDS: TClientDataSet): UTF8String;

167.

var

168.

i,j: Integer;

169.

keyValue:String;

170.

jsonList:TStringList;

171.

jsonResult:String;

172.

begin

173.

if

not srcCDS.Active then srcCDS.Open;

174.

 

175.

try

176.

jsonList := TStringList.Create;

177.

srcCDS.DisableControls;

178.

srcCDS.First;

179.

while

not srcCDS.Eof

do

180.

begin

181.

keyValue:=

''

;

182.

for

i := 0 to srcCDS.FieldDefs.Count -1

do

183.

begin

184.

keyValue:= keyValue + Format(

'"%s":"%s",'

,[srcCDS.Fields[i].FieldName,
srcCDS.Fields[i].AsString]);

185.

 

186.

end;

187.

jsonList.Add(Format(

'{%s}'

,[Copy(keyValue,
0,Length(keyValue)-1)]));

188.

srcCDS.Next;

189.

end;

190.

for

i := 0 to jsonList.Count -1

do

191.

begin

192.

jsonResult := jsonResult + jsonList[i] +

','

;

193.

end;

194.

Result:= Utf8Encode(Format(

'[%s]'

,
[Copy(jsonResult,0,Length(jsonResult)-1)]));

195.

finally

196.

srcCDS.EnableControls;

197.

jsonList.Free;

198.

end;

199.

end;

200.

 

201.

 

202.

 

203.

end.

 

使用范例

01.
[code]//取得资料 www.it165.net

[/code]

02.

procedure TForm1.btnRefreshClick(Sender: TObject);

03.

var

04.

getString:string;

05.

json: ISuperObject;

06.

ja: TSuperArray;

07.

begin

08.

try

09.

getString := idhtp1.Get(

'http://localhost/xuan/wsLine.php'

);

10.

json :=SO(getString);

11.

ja := json.AsArray;

12.

 

13.

TJSONDB.JsonToClientDataSet(ja,cdsMain);

14.

finally

15.

 

16.

end;

17.

end;

18.

//写入资料

19.

procedure TForm1.btnSubmitClick(Sender: TObject);

20.

var

21.

jsonString:string;

22.

jsonStream:TStringStream;

23.

begin

24.

if

cdsNew.State

in

[dsEdit] then cdsNew.Post;

25.

try

26.

jsonString:= TJSONDB.ClientDataSetToJSON(cdsNew);

27.

 

28.

jsonStream := TStringStream.Create(jsonString);

29.

 

30.

idhtp1.HandleRedirects := True;

31.

idhtp1.ReadTimeout := 5000;

32.

idhtp1.Request.ContentType :=

'application/json'

;

33.

idhtp1.Post(

'http://localhost/xuan/wsLine.php?action=insert'

,jsonStream);

34.

 

35.

finally

36.

jsonStream.Free;

37.

end;

38.

end;

 
JSON格式参考

[{"id":"0987336122","name":"\u738b\u5c0f\u660e","content":"","misc_type":"Jpeg","misc":null,"msg_date":"2012-10-09 11:18:38"},

{"id":"0987336122","name":"\u674e\u5c0f\u83ef","content":"","misc_type":"Jpeg","misc":null,"msg_date":"2012-10-09 11:18:45"}]