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

最新推荐文章于 2025-04-22 14:21:34 发布
利客阿平
最新推荐文章于 2025-04-22 14:21:34 发布
阅读量1.9k
点赞数
分类专栏： WEB开发手机开发
手机开发同时被 2 个专栏收录
36 篇文章
订阅专栏
WEB开发
6 篇文章
订阅专栏
先下载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"}]