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.             if Not found then I:=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.//取得資料 www.it165.net

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"}]