现在,DATASNAP倾向于使用JSON作为统一的数据序列格式,以期达到跨平台的效果。于是使用JSON便成为热点。

unit uJSONDB;
 
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) do
          begin
          found:=false;
          if aString[i]<=#128 then
             begin
             for j:=Low(Fmt) to High(Fmt) do
                 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;
//從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;
 
//從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轉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,100, 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.

使用範例

//取得資料
procedure TForm1.btnRefreshClick(Sender: TObject);
var
  getString:string;
  json: ISuperObject;
  ja: TSuperArray;
begin
  try
    getString := idhtp1.Get('http://localhost/xuan/wsLine.php');
    json :=SO(getString);
    ja := json.AsArray;
 
    TJSONDB.JsonToClientDataSet(ja, cdsMain);
  finally
 
  end;
end;
//寫入資料
procedure TForm1.btnSubmitClick(Sender: TObject);
var
  jsonString:string;
  jsonStream:TStringStream;
begin
  if cdsNew.State in [dsEdit] then cdsNew.Post;
  try
    jsonString:= TJSONDB.ClientDataSetToJSON(cdsNew);
 
    jsonStream := TStringStream.Create(jsonString);
 
    idhtp1.HandleRedirects := True;
    idhtp1.ReadTimeout := 5000;
    idhtp1.Request.ContentType := 'application/json';
    idhtp1.Post('http://localhost/xuan/wsLine.php?action=insert',jsonStream);
 
  finally
    jsonStream.Free;
  end;
end;
 http://www.cnblogs.com/hnxxcxg/archive/2013/02/20/2919813.html

clientdataset<---->json的更多相关文章

  1. JSON和数据集互相转换单元

    如题......只是一个单元, 为了测试JSON单元性能的... 具体测试结果参考: http://www.cnblogs.com/hs-kill/p/3668052.html 代码中用到的Seven ...

  2. DataSnap 多层返回数据集分析FireDAC JSON

    采用服务器返回数据,一种是返回字符串数据例如JSON,跨平台跨语言,任何语言调用都支持兼容,类似WEBService. 第二种是紧密结合c++builder语言,传输DataSet,可以是Client ...

  3. delphi中json转dataset

    unit uJSONDB; interface uses SysUtils, Classes, Variants, DB, DBClient, SuperObject, Dialogs; type T ...

  4. 使用TSQL查询和更新 JSON 数据

    JSON是一个非常流行的,用于数据交换的文本数据(textual data)格式,主要用于Web和移动应用程序中.JSON 使用“键/值对”(Key:Value pair)存储数据,能够表示嵌套键值对 ...

  5. 【疯狂造轮子-iOS】JSON转Model系列之二

    [疯狂造轮子-iOS]JSON转Model系列之二 本文转载请注明出处 —— polobymulberry-博客园 1. 前言 上一篇<[疯狂造轮子-iOS]JSON转Model系列之一> ...

  6. 【疯狂造轮子-iOS】JSON转Model系列之一

    [疯狂造轮子-iOS]JSON转Model系列之一 本文转载请注明出处 —— polobymulberry-博客园 1. 前言 之前一直看别人的源码,虽然对自己提升比较大,但毕竟不是自己写的,很容易遗 ...

  7. Taurus.MVC 2.2 开源发布:WebAPI 功能增强(请求跨域及Json转换)

    背景: 1:有用户反馈了关于跨域请求的问题. 2:有用户反馈了参数获取的问题. 3:JsonHelper的增强. 在综合上面的条件下,有了2.2版本的更新,也因此写了此文. 开源地址: https:/ ...

  8. .NET Core系列 : 2 、project.json 这葫芦里卖的什么药

    .NET Core系列 : 1..NET Core 环境搭建和命令行CLI入门 介绍了.NET Core环境,本文介绍.NET Core中最重要的一个配置文件project.json的相关内容.我们可 ...

  9. 一个粗心的Bug,JSON格式不规范导致AJAX错误

    一.事件回放  今天工作时碰到了一个奇怪的问题,这个问题很早很早以前也碰到过,不过没想到过这么久了竟然又栽在这里. 当时正在联调一个项目,由于后端没有提供数据接口,于是我直接本地建立了一个 json ...

随机推荐

  1. javascript 学习随笔2

    <html> <head> <script type="text/javascript"> function writeText(txt) { ...

  2. 解决Spring中singleton的Bean依赖于prototype的Bean的问题

    在spring bean的配置的时候,可能会出现一个singleton的bean依赖一个prototype的bean.因为singleton的bean只有一次初始化的机会,所以他们的依赖关系页只有在初 ...

  3. Linux下VNC的安装和开机启动

    1.确认VNC是否安装默认情况下,Red Hat Enterprise Linux安装程序会将VNC服务安装在系统上.确认是否已经安装VNC服务及查看安装的VNC版本[root@testdb ~]# ...

  4. W5100使用中的常见问题

    来自:成都浩然 越来越多的嵌入式网络系统project师喜欢上了W5100,它集TCP/IP协议栈.以太网的MAC和PHY一体,不仅使系统性能得到非常大的提升,也给产品开发工作带来极大的方便.随着W5 ...

  5. 正态分布(Normal distribution)又名高斯分布(Gaussian distribution)

    正态分布(Normal distribution)又名高斯分布(Gaussian distribution),是一个在数学.物理及project等领域都很重要的概率分布,在统计学的很多方面有着重大的影 ...

  6. 简单字符串处理 hdu2532 Engine

    本来可以把这篇文章放入上一篇文章里,不过做这个题花了一点时间,也有一点收获,同时觉得网上的这个题目可供参考的文章有些少,那么就单独成篇吧. 首先分析下题目思路: 这个题目是个模拟题,步骤也很清晰. 首 ...

  7. java--内部类实现“类的多重继承”

    class Fa1{ private int k = 1; void show() { System.out.println(k); } } class Fa2{ private int k = 10 ...

  8. 基于visual Studio2013解决C语言竞赛题之0804成绩筛选

     题目

  9. linux查看接口连接状态

    ethtool # ethtool em1 Settings for em1: Supported ports: [ TP ] Supported link modes: 10baseT/Half 1 ...

  10. linux服务之NFS和SAMBA服务

    这几种网络文件传输最适合局域网.网络中用FTP 一:NFS服务 nfs(network file system)网络文件系统,改服务依赖于rpcbind服务.client通过rpc訪问server端的 ...