JSON和数据集互相转换单元

unit DSCJSON;

(*
作者: 刘志林
最后修改日期: 2015-11-12
版本: 1.2

修改历史:
  1.2
    支持QJSON
    增加SYSTEM.JSON单元支持(D10中新单元, 就是原有的DBXJSON)
  1.1
    支持FireDAC
    增加DBXJSON单元支持
    增加对NULL值字段支持
  1.0:
    支持ADO/ClientDataset与JSON互相转换
    使用SuperObject单元作为JSON解析单元

联系方式: hs_kill_god@hotmail.com

!!! 若有修改,请通知作者,谢谢合作 !!!
*)

{$DEFINE FIREDAC}

{$DEFINE QJSON}
//{$DEFINE JSON_SO}
//{$DEFINE JSON_DBX}
//{$DEFINE JSON_SYS}

interface

uses
  SysUtils, Classes, DB, DBClient, DateUtils
{$IFDEF JSON_DBX}
  , DBXJSON
{$ENDIF}
{$IFDEF JSON_SO}
  , superobject, Variants
{$ENDIF}
{$IFDEF FIREDAC}
  , FireDAC.Comp.DataSet
{$ENDIF}
{$IFDEF JSON_SYS}
  , System.JSON
{$ENDIF}
{$IFDEF QJSON}
  , QJSON
{$ENDIF}
  , ADODB, EncdDecd;

/// <summary>将数据集转化为JSON数据</summary>
/// <param name="ADataSet">TDataSet - 数据集</param>
/// <param name="AJSON">WideString - 输出转换结果</param>
/// <returns>转换结果 成功: True 失败: False</returns>
function DataSetToJSON(ADataSet: TDataSet; var AJSON: WideString): Boolean;

/// <summary>JSON数据转换为结果集</summary>
/// <param name="AJSON">JSON数据</param>
/// <param name="ADataSet">数据集</param>
/// <returns>转换结果 成功: True 失败: False</returns>
function JSONToDataSet(AJSON: WideString; ADataSet: TDataSet): Boolean;

implementation

(*
  C: 配置表
    C.CE 字符编码
      0:ANSI 1:UNICODE 2:UTF-8
      默认 1
    C.BC 二进制字段是否压缩
      0:未压缩 1:已压缩
      默认 0
    C.CM 压缩模式
      0:ZIP 1:RAR 2:7-ZIP
      默认 2
    C.BE 二进制字段编码类型
      0:BASE64 1:
      默认 0


  T: 表结构表
    T.N:列名
    T.D:显示列名
    T.T:列数据类型 Data.DB.TFieldType
    T.L:列数据长度
    T.R:列值是否允许为空

  R: 数据表

{
  "C":{"Encode":1, "BolbComp":0, "CompMode":2},
  "T":[
    {"N":"FieldName", "D":"DisplayName", "T":0, "L":100, "R":1},
  ],
  "R":[
    ["Field1Value", "Field2Value"]
  ],
}

*)

const
  _FT_STRING = $00; {字符}
  _FT_INTEGER = $01; {整形}
  _FT_FLOAT = $02; {浮点}
  _FT_DATETIME = $03; {日期}
  _FT_BOOLEAN = $04; {布尔}
  _FT_BLOB = $05; {二进制}

  _FT_CURRENCY = $10; {金额}


function JSONToDataSet(AJSON: WideString; ADataSet: TDataSet): Boolean;
var
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
  nJDS: TJSONObject;
{$ENDIF}
{$IFDEF JSON_SO}
  nJDS: ISuperObject;
{$ENDIF}
{$IFDEF QJSON}
  nJDS: TQJson;
{$ENDIF}

  function _JTDStepField: Boolean;
  var
    nFName, nFDisplay: String;
    i, nFLength: Integer;
    nFType: Byte;
    nFD: TFieldDef;
    nFRequired: Boolean;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
    nJA: TJSONArray;
    nJO: TJSONObject;
    nJV: TJSONValue;
    nJP: TJSONPair;
{$ENDIF}
{$IFDEF JSON_SO}
    nJA: TSuperArray;
    nJO, nJR: ISuperObject;
{$ENDIF}
{$IFDEF QJSON}
    nJO, nJR: TQJson;
{$ENDIF}
  begin
    Result := False;
    ADataSet.Close;

{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
    nJA := nJDS.GetValue(‘T‘) as TJSONArray;
    if nJA = nil then
      Exit;
{$ENDIF}
{$IFDEF JSON_SO}
    nJO := nJDS.N[‘T‘];
    if nJO.DataType = stNull then
      Exit;
{$ENDIF}
{$IFDEF QJSON}
    nJO := nJDS.ItemByName(‘T‘);
    if nJO.DataType = jdtNull then
      Exit;
{$ENDIF}

    ADataSet.FieldDefs.BeginUpdate;
    try
      ADataSet.FieldDefs.Clear;

    {拆解Field}
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
      for i := 0 to nJA.Size - 1 do
      begin
        nJO := nJA.Get(i) as TJSONObject;
        nFName := nJO.GetValue(‘N‘).Value;
        nFDisplay := nJO.GetValue(‘D‘).Value;
        nFType := TJSONNumber(nJO.GetValue(‘T‘)).AsInt;
        nFLength := TJSONNumber(nJO.GetValue(‘L‘)).AsInt;
        nFRequired := Boolean(TJSONNumber(nJO.GetValue(‘R‘)).AsInt);
{$ENDIF}
{$IFDEF JSON_SO}
      nJA := nJO.AsArray;
      for i := 0 to nJA.Length - 1 do
      begin
        nJR := nJA[i];
        nFName := nJR[‘N‘].AsString;
        nFDisplay := nJR[‘D‘].AsString;
        nFType := nJR[‘T‘].AsInteger;
        nFLength := nJR[‘L‘].AsInteger;
        nFRequired := Boolean(nJR[‘R‘].AsInteger);
{$ENDIF}
{$IFDEF QJSON}
      for i := 0 to nJO.Count - 1 do
      begin
        nJR := nJO.Items[i];
        nFName := nJR.ItemByName(‘N‘).AsString;
        nFDisplay := nJR.ItemByName(‘D‘).AsString;
        nFType := nJR.ItemByName(‘T‘).AsInteger;
        nFLength := nJR.ItemByName(‘L‘).AsInteger;
        nFRequired := Boolean(nJR.ItemByName(‘R‘).AsInteger);
{$ENDIF}
        nFD := ADataSet.FieldDefs.AddFieldDef;
        with nFD do
        try
          Name := nFName;
          case nFType of
            _FT_INTEGER:
              DataType := ftLargeint;
            _FT_FLOAT:
              DataType := ftFloat;
            _FT_DATETIME:
              DataType := ftDateTime;
            _FT_BOOLEAN:
              DataType := ftBoolean;
            _FT_BLOB:
              DataType := ftBlob;
            _FT_CURRENCY:
              DataType := ftCurrency;
          else
            DataType := ftString;
            Size := nFLength;
          end;
          Required := nFRequired;
          DisplayName := nFDisplay;
        except
          DisposeOf;
        end;
      end;
    finally
      ADataSet.FieldDefs.EndUpdate;
    end;
    Result := True;
  end;

  function _JTDStepRecord: Boolean;
  var
    nFName, nStr: String;
    i, j: Integer;
    nField: TField;
    nMSI, nMSO: TMemoryStream;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
    nJA, nJRA: TJSONArray;
{$ENDIF}
{$IFDEF JSON_SO}
    nJA, nJRA: TSuperArray;
    nJO, nJR: ISuperObject;
{$ENDIF}
{$IFDEF QJSON}
    nJO, nJRA: TQJson;
{$ENDIF}
  begin
    Result := False;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
    nJA := nJDS.GetValue(‘R‘) as TJSONArray;
    if nJA = nil then
      Exit;
{$ENDIF}
{$IFDEF JSON_SO}
    nJO := nJDS.N[‘R‘];
    if nJO.DataType = stNull then
      Exit;
    nJA := nJO.AsArray;
{$ENDIF}
{$IFDEF QJSON}
    nJO := nJDS.ItemByName(‘R‘);
    if nJO.DataType = jdtNull then
      Exit;
{$ENDIF}
    nMSO := TMemoryStream.Create;
    nMSI := TStringStream.Create;
    ADataSet.DisableControls;
    try
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
      for i := 0 to nJA.Size - 1 do
      begin
        nJRA := nJA.Get(i) as TJSONArray;
{$ENDIF}
{$IFDEF JSON_SO}
      for i := 0 to nJA.Length - 1 do
      begin
        nJRA := nJA[i].AsArray;
{$ENDIF}
{$IFDEF QJSON}
      for i := 0 to nJO.Count - 1 do
      begin
        nJRA := nJO.Items[i];
{$ENDIF}
        ADataSet.Append;
        for j := 0 to ADataSet.Fields.Count - 1 do
        begin
          nField := ADataSet.Fields[j];
          nFName := nField.FieldName;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
          if nJRA.Get(j).Null then
{$ENDIF}
{$IFDEF JSON_SO}
          if nJRA[j].DataType = stNull then
{$ENDIF}
{$IFDEF QJSON}
          if nJRA[j].DataType = jdtNull then
{$ENDIF}
          begin
            nField.SetData(nil);
          end
          else
          begin
            case nField.DataType of
              ftLargeint:
              begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                nField.Value := TJSONNumber(nJRA.Get(j)).AsInt64;
{$ENDIF}
{$IFDEF JSON_SO}
                nField.Value := nJRA[j].AsInteger;
{$ENDIF}
{$IFDEF QJSON}
                nField.Value := nJRA.Items[j].AsInteger;
{$ENDIF}
              end;
              ftFloat, ftCurrency:
              begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                nField.Value := TJSONNumber(nJRA.Get(j)).AsDouble;
{$ENDIF}
{$IFDEF JSON_SO}
                nField.Value := nJRA[j].AsDouble;
{$ENDIF}
{$IFDEF QJSON}
                nField.Value := nJRA.Items[j].AsFloat;
{$ENDIF}
              end;
              ftDateTime:
              begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                nField.Value := UnixToDateTime(TJSONNumber(nJRA.Get(j)).AsInt64);
{$ENDIF}
{$IFDEF JSON_SO}
                nField.Value := UnixToDateTime(nJRA[j].AsInteger);
{$ENDIF}
{$IFDEF QJSON}
                nField.Value := UnixToDateTime(nJRA.Items[j].AsInt64);
{$ENDIF}
              end;
              ftBoolean:
              begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                nField.Value := Boolean(TJSONNumber(nJRA.Get(j)).AsInt);
{$ENDIF}
{$IFDEF JSON_SO}
                nField.Value := Boolean(nJRA[j].AsInteger);
{$ENDIF}
{$IFDEF QJSON}
                nField.Value := Boolean(nJRA.Items[j].AsInteger);
{$ENDIF}
              end;
              ftBlob:
              begin
                nMSI.Clear;
                nMSO.Clear;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                nStr := TJSONString(nJRA.Get(j)).Value;
{$ENDIF}
{$IFDEF JSON_SO}
                nStr := nJRA[j].AsString;
{$ENDIF}
{$IFDEF QJSON}
                nStr := nJRA.Items[j].AsString;
{$ENDIF}
                nMSI.Write(nStr[1], Length(nStr) * SizeOf(Char));
                nMSI.Position := 0;
                DecodeStream(nMSI, nMSO);
                nMSO.Position := 0;
                TBlobField(nField).LoadFromStream(nMSO);
              end;
            else
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
              nField.Value := TJSONString(nJRA.Get(j)).Value;
{$ENDIF}
{$IFDEF JSON_SO}
              nField.Value := nJRA[j].AsString;
{$ENDIF}
{$IFDEF QJSON}
              nField.Value := nJRA.Items[j].AsString;
{$ENDIF}
            end;
          end;
        end;
        ADataSet.Post;
      end;
      ADataSet.First;
    finally
      ADataSet.EnableControls;
      nMSO.Free;
      nMSI.Free;
    end;
    Result := True;
  end;

begin
  if ADataSet = nil then
    Exit;

{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
  nJDS := TJSONObject.ParseJSONValue(AJSON) as TJSONObject;
  try
{$ENDIF}
{$IFDEF JSON_SO}
  nJDS := SO(AJSON);
{$ENDIF}
{$IFDEF QJSON}
  nJDS := TQJson.Create;
  nJDS.Parse(AJSON);
  try
{$ENDIF}
    try
      if ADataSet is TCustomClientDataSet then
      begin
        Result := _JTDStepField;
        if Result then
        begin
          TCustomClientDataSet(ADataSet).CreateDataSet;
          Result := _JTDStepRecord;
        end;
      end
      else if ADataSet is TADODataSet then
      begin
        Result := _JTDStepField;
        if Result then
        begin
          TADODataSet(ADataSet).CreateDataSet;
          Result := _JTDStepRecord;
        end;
      end
{$IFDEF FIREDAC}
      else if ADataSet is TFDDataSet then
      begin
        Result := _JTDStepField;
        if Result then
        begin
          TFDDataSet(ADataSet).CreateDataSet;
          Result := _JTDStepRecord;
        end;
      end
{$ENDIF}
      else
        Result := False;
    except
      Result := False;
    end;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
  finally
    nJDS.Free;
  end;
{$ENDIF}
{$IFDEF QJSON}
  finally
    nJDS.Free;
  end;
{$ENDIF}
end;

function DataSetToJSON(ADataSet: TDataSet; var AJSON: WideString): Boolean;
var
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
  nJDS, nJO: TJSONObject;
  nJA, nJRA: TJSONArray;
{$ENDIF}
{$IFDEF JSON_SO}
  nJDS, nJR: ISuperObject;
  nJA, nJRA: TSuperArray;
{$ENDIF}
{$IFDEF QJSON}
  nJDS, nJA, nJRA: TQJson;
{$ENDIF}
  i: Integer;
  nStr, nFDisplay: string;
  nField: TField;
  nFT: Byte;
  nMSI: TMemoryStream;
  nSSO: TStringStream;
const
  _DEF_TITLE = ‘{"C":{"CE":1,"BC":0},"T":[],"R":[]}‘;
  _DEf_RECORD = ‘{"N":"%s","D":"%s","T":%d,"L":%d,"R":%d}‘;
begin
  Result := False;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
  nJDS := TJSONObject.ParseJSONValue(_DEF_TITLE) as TJSONObject;
  nJA := nJDS.GetValue(‘T‘) as TJSONArray;
{$ENDIF}
{$IFDEF JSON_SO}
  nJDS := SO(_DEF_TITLE);
  nJA := nJDS.A[‘T‘];
{$ENDIF}
{$IFDEF QJSON}
  nJDS := TQJson.Create;
  nJDS.Parse(_DEF_TITLE);
  nJA := nJDS.ItemByName(‘T‘);
{$ENDIF}
  ADataSet.DisableControls;
  try
    AJSON := ‘‘;
    try
      ADataSet.First;
      for i := 0 to ADataSet.Fields.Count - 1 do
      begin
        nField := ADataSet.Fields[i];
        case nField.DataType of
          ftSmallint, ftInteger, ftWord, ftLargeint, ftLongWord, ftShortint, ftByte:
            nFT := _FT_INTEGER;
          ftFloat, ftBCD, ftSingle, ftExtended:
            nFT := _FT_FLOAT;
          ftDate, ftTime, ftDateTime:
            nFT := _FT_DATETIME;
          ftBoolean:
            nFT := _FT_BOOLEAN;
          ftBlob, ftMemo, ftGraphic:
            nFT := _FT_BLOB;
          ftCurrency:
            nFT := _FT_CURRENCY;
        else
          nFT := _FT_STRING;
        end;
        if nField.DisplayLabel = nField.FieldName then
          nFDisplay := ‘‘
        else
          nFDisplay := nField.DisplayLabel;
        nStr := Format(_DEf_RECORD, [nField.FieldName, nFDisplay, nFT,
          nField.DataSize, Byte(nField.Required)]);
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
        nJA.AddElement(TJSONObject.ParseJSONValue(nStr));
{$ENDIF}
{$IFDEF JSON_SO}
        nJA.Add(SO(nStr));
{$ENDIF}
{$IFDEF QJSON}
        nJA.Add.Parse(nStr);
{$ENDIF}
      end;

{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
      nJA := nJDS.GetValue(‘R‘) as TJSONArray;
{$ENDIF}
{$IFDEF JSON_SO}
      nJA := nJDS.A[‘R‘];
{$ENDIF}
{$IFDEF QJSON}
      nJA := nJDS.ItemByName(‘R‘);
{$ENDIF}
      nMSI := TMemoryStream.Create;
      nSSO := TStringStream.Create;
      try
        while not ADataSet.Eof do
        begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
          nJRA := TJSONArray.Create;
          nJA.AddElement(nJRA);
{$ENDIF}
{$IFDEF JSON_SO}
          nJR := SA([]);
          nJA.Add(nJR);
          nJRA := nJR.AsArray;
{$ENDIF}
{$IFDEF QJSON}
          nJRA := nJA.Add(‘‘, jdtArray);
{$ENDIF}
          for i := 0 to ADataSet.Fields.Count - 1 do
          begin
            nField := ADataSet.Fields[i];
            if nField.IsNull then
            begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
              nJRA.AddElement(TJSONNull.Create);
{$ENDIF}
{$IFDEF JSON_SO}
              nJRA.Add(SO(NULL));
{$ENDIF}
{$IFDEF QJSON}
              nJRA.Add(‘‘, jdtNull);
{$ENDIF}
            end
            else
            begin
              case nField.DataType of
                ftSmallint, ftInteger, ftWord, ftLargeint, ftLongWord, ftShortint, ftByte:
                begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                  nJRA.Add(nField.AsInteger);
{$ENDIF}
{$IFDEF JSON_SO}
                  nJRA.Add(SO(nField.AsInteger));
{$ENDIF}
{$IFDEF QJSON}
                  nJRA.Add.AsInteger := nField.AsInteger;
{$ENDIF}
                end;
                ftFloat, ftBCD, ftSingle, ftExtended, ftCurrency:
                begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                  nJRA.Add(nField.AsFloat);
{$ENDIF}
{$IFDEF JSON_SO}
                  nJRA.Add(SO(nField.AsFloat));
{$ENDIF}
{$IFDEF QJSON}
                  nJRA.Add.AsFloat := nField.AsFloat;
{$ENDIF}
                end;
                ftDate, ftTime, ftDateTime:
                begin
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                  nJRA.Add(DateTimeToUnix(nField.AsDateTime));
{$ENDIF}
{$IFDEF JSON_SO}
                  nJRA.Add(SO(DateTimeToUnix(nField.AsDateTime)));
{$ENDIF}
{$IFDEF QJSON}
                  nJRA.Add.AsInt64 := DateTimeToUnix(nField.AsDateTime);
{$ENDIF}
                end;
                ftBlob, ftMemo, ftGraphic:
                begin
                  nMSI.Clear;
                  nSSO.Clear;
                  TBlobField(nField).SaveToStream(nMSI);
                  nMSI.Position := 0;
                  EncodeStream(nMSI, nSSO);
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                  nJRA.Add(nSSO.DataString);
{$ENDIF}
{$IFDEF JSON_SO}
                  nJRA.Add(SO(nSSO.DataString));
{$ENDIF}
{$IFDEF QJSON}
                  nJRA.Add.AsString := nSSO.DataString;
{$ENDIF}
                end;
              else
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
                nJRA.Add(nField.AsString);
{$ENDIF}
{$IFDEF JSON_SO}
                nJRA.Add(SO(nField.AsString));
{$ENDIF}
{$IFDEF QJSON}
                nJRA.Add.AsString := nField.AsString;
{$ENDIF}
              end;
            end;
          end;
          ADataSet.Next;
        end;
      finally
        nMSI.Free;
        nSSO.Free;
      end;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
      AJSON := nJDS.ToString;
{$ENDIF}
{$IFDEF JSON_SO}
      AJSON := nJDS.AsJSon(False, False);
{$ENDIF}
{$IFDEF QJSON}
      AJSON := nJDS.Encode(False);
{$ENDIF}
      Result := True;
    except
    end;
  finally
    ADataSet.EnableControls;
{$IF DEFINED(JSON_DBX) OR DEFINED(JSON_SYS)}
    nJDS.Free;
{$ENDIF}
{$IFDEF QJSON}
    nJDS.Free;
{$ENDIF}
  end;
end;

end.