delphi datasnap client…

http://www.cnblogs.com/hnxxcxg

http://www.cnblogs.com/hnxxcxg/archive/2013/02/20/2919813.html

<wbr></wbr>

<wbr></wbr>

clientdataset<---->json

<wbr></wbr>

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


unit uJSONDB;

<wbr></wbr>

  uses

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

  type

    TJSONDB = 

<wbr></wbr>

       function getJsonFieldNames(res: ISuperObject):TStringList ;

       function getJsonFieldValues(res: ISuperObject):TStringList ;

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

       function ClientDataSetToJSON(srcCDS: TClientDataSet):UTF8String;

  end;

<wbr></wbr>

implementation

<wbr></wbr>

function GetToken(var astring: ;

var

   i,j:integer;

   Found:Boolean;

begin

    found:=;

    result:=;

    aString := TrimLeft(aString);

<wbr></wbr>

     length(astring)=0 then exit;

<wbr></wbr>

    I:=1;

          begin

          found:=;

           aString[i]<=#128 then

             begin

                 begin

                 ;

                 found:=;

                 ;

                 end;

              Not found then I:=I+1;

             end

           I:=I+2;

<wbr></wbr>

          ;

          end;

<wbr></wbr>

     found then

    begin

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

      delete(astring,1,i);

    end

    begin

      result:=astring;

      astring:=;

    end;

end;

<wbr></wbr>

function GetFieldParams(PropName, Source:;

var

   S1, S2: ;

   TmpParam: ;

   AChar: ;

   aValue, aPropName, aSource: ;

begin

   Result:=;

    then Exit;

   aSource := Source;

   begin

     aValue := GetToken(aSource,[]);

     aPropName := GetToken(aValue,[]);

     ;

     Result := aValue;

     ;

   end;

end;

 function TJSONDB.getJsonFieldNames(res: ISuperObject):TStringList ;

var

  i: Integer;

  fieldList : TStringList;

  fieldNames :String;

begin

    fieldList := TStringList.Create;

    fieldNames := res.AsObject.getNames.AsString;

    fieldNames := StringReplace(fieldNames, , [rfReplaceAll, rfIgnoreCase]);

    fieldNames := StringReplace(fieldNames, , [rfReplaceAll, rfIgnoreCase]);

    fieldNames := StringReplace(fieldNames, , [rfReplaceAll, rfIgnoreCase]);

<wbr></wbr>

    fieldList.Delimiter := ;

    fieldList.DelimitedText := fieldNames;

    Result:= fieldList;

  end;

end;

<wbr></wbr>

 function TJSONDB.getJsonFieldValues(res: ISuperObject):TStringList ;

var

  i: Integer;

  fieldList : TStringList;

  fieldValues :String;

begin

    fieldList := TStringList.Create;

    fieldValues := res.AsObject.getValues.AsString;

    fieldValues := StringReplace(fieldValues, , [rfReplaceAll, rfIgnoreCase]);

    fieldValues := StringReplace(fieldValues, , [rfReplaceAll, rfIgnoreCase]);

    fieldValues := StringReplace(fieldValues, , [rfReplaceAll, rfIgnoreCase]);

<wbr></wbr>

    fieldList.Delimiter := ;

    fieldList.DelimitedText := fieldValues;

    Result:= fieldList;

  end;

end;

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

var

  fieldList: TStringList;

  valuesList: TStringList;

  jsonSrc: ;

  i, j: Integer;

begin

<wbr></wbr>

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

   (dstCDS.FieldCount = 0) then

  begin

    begin

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

    end;

    dstCDS.CreateDataSet;

    dstCDS.Close;

    dstCDS.Open;

  end;

    dstCDS.DisableControls;

    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;

      begin

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

      end;

      dstCDS.Post;

    end;

<wbr></wbr>

    dstCDS.EnableControls;

  end;

end;

 function TJSONDB.ClientDataSetToJSON(srcCDS: TClientDataSet): UTF8String;

var

  i, j: Integer;

  keyValue:String;

  jsonList:TStringList;

  jsonResult:String;

begin

   not srcCDS.Active then srcCDS.Open;

<wbr></wbr>

    jsonList := TStringList.Create;

    srcCDS.DisableControls;

    srcCDS.First;

    begin

      keyValue:= ;

      begin

        keyValue:= keyValue + Format(,[srcCDS.Fields[i].FieldName, srcCDS.Fields[i].AsString]);

<wbr></wbr>

      end;

      jsonList.Add(Format(,[Copy(keyValue, 0, Length(keyValue)-1)]));

      srcCDS.Next;

    end;

    begin

      jsonResult := jsonResult + jsonList[i] + ;

    end;

    Result:= Utf8Encode(Format(, [Copy(jsonResult, 0, Length(jsonResult)-1)]));

    srcCDS.EnableControls;

    jsonList.Free;

  end;

end;

<wbr></wbr>

<wbr></wbr>

<wbr></wbr>

end.

使用範例

procedure TForm1.btnRefreshClick(Sender: TObject);

var

  getString:

  json: ISuperObject;

  ja: TSuperArray;

begin

    getString := idhtp1.Get(

    json :=SO(getString);

    ja := json.AsArray;

<wbr></wbr>

    TJSONDB.JsonToClientDataSet(ja, cdsMain);

<wbr></wbr>

  end;

end;

procedure TForm1.btnSubmitClick(Sender: TObject);

var

  jsonString:

  jsonStream:TStringStream;

begin

    jsonString:= TJSONDB.ClientDataSetToJSON(cdsNew);

<wbr></wbr>

    jsonStream := TStringStream.Create(jsonString);

<wbr></wbr>

    idhtp1.HandleRedirects := True;

    idhtp1.ReadTimeout := 5000;

    idhtp1.Request.ContentType := 

    idhtp1.Post(

<wbr></wbr>

    jsonStream.Free;

  end;

end;

<wbr></wbr>