分享一个Delphi里的自定义类JSON序列化的基础单元

5bug 2017-12-31 32人围观 ,发现0个评论 Delphi序列化Delphi反序列化FireMonkey序列化

引言

把对象转换为字节序列的过程称为对象的序列化;把字节序列恢复为对象的过程称为对象的反序列化。现在各种数据传输等都支持序列化反序列化,尤其是java里序列化非常常见,序列化有助于编程中快速的解析数据,大大提高编码效率!本人也将自己使用了多年的Delphi里的序列化反序列化的单元分享出来~

基础类

以下单元基于Delphi10.2里编译正常,编译开关“SystemJSON”的作用是用于选择底层josn使用哪种解析库,如果定义了则使用System.JSON,未定义则使用mORMot里的json解析库了。mORMot开源框架本站可以搜到相关的连接!本基础类支持从json字符解析出对应的类,也支持将基于TBaseObject的类序列化出json字符串,支持常见的各种数据类型。同时也支持保存到文件,从文件序列化。如果要跨平台使用本单元则需要定义“SystemJSON”编译指令。

序列号基础类源码如下:

unit uBaseObject;

interface

uses
  System.SysUtils, System.Classes, System.Types, System.TypInfo{$IFNDEF SystemJSON}, SynCommons {$ELSE},
  System.JSON{$ENDIF};

type
  TBaseObjectClass = class of TBaseObject;

  TBaseObject = class(TPersistent)
  private
    FSkipPropList: TStringList;
  protected
    procedure AutoDestroy; virtual;
    function GetJsonString: string; virtual;
    procedure AddSkipProp(const APropName: string);
    function InSkipPropList(const APropName: string): Boolean;
  public
    constructor Create; overload; virtual;
    constructor Create(const AJsonString: string); overload; virtual;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    function SaveToFile(const AFileName: string): Boolean; virtual;
    function LoadFormFile(const AFileName: string): Boolean; virtual;
    // 复制类
    function CopyFrom(const ASrcObj: TBaseObject): Boolean;
    // JSON赋值
    function AssignFromJson(const AJsonString: string): Boolean;
    // 获取类JSON字符
    property JsonString: string read GetJsonString;
  end;

function ObjectToJsonString(const AClass: TObject): string;
function JsonToObject(const AJsonData: string; const AClass: TClass): TObject; overload;
function JsonToObject(const AJsonData: string; const AObject: TObject): Boolean; overload;
procedure GetDynArrayElTypeInfo(typeInfo: PTypeInfo; var EltInfo: PTypeInfo; var Dims: Integer);

{$IFNDEF SystemJSON}
{$ELSE}
function ObjectToJson(const AClass: TObject): TJSOnObject;
{$ENDIF}

implementation

{$IFNDEF SystemJSON}

function S2U(const Text: string): RawUTF8;
begin
{$IFDEF UNICODE}
  RawUnicodeToUtf8(PWideChar(Pointer(Text)), length(Text), Result);
{$ELSE}
  Result := CurrentAnsiConvert.AnsiBufferToRawUTF8(Pointer(Text), length(Text));
{$ENDIF}
end;

function U2S(const Text: RawUTF8): string;
begin
{$IFDEF UNICODE}
  UTF8DecodeToUnicodeString(Pointer(Text), length(Text), Result);
{$ELSE}
  Result := CurrentAnsiConvert.UTF8BufferToAnsi(Pointer(Text), length(Text));
{$ENDIF}
end;
{$ENDIF}

type
  // RawUTF8 = type AnsiString(CP_UTF8);
  RawUTF8 = UTF8String;
  TObjectArray = array of TObject;

function ReadByte(var P: Pointer): Byte;
begin
  Result := Byte(P^);
  P := Pointer(NativeInt(P) + 1);
end;

function ReadWord(var P: Pointer): Word;
begin
  Result := Word(P^);
  P := Pointer(NativeInt(P) + 2);
end;

function ReadLong(var P: Pointer): Integer;
begin
  Result := Integer(P^);
  P := Pointer(NativeInt(P) + 4);
end;

function ReadPointer(var P: Pointer): Pointer;
begin
  Result := Pointer(P^);
  P := Pointer(NativeInt(P) + SizeOf(Pointer));
end;

function ReadString(var P: Pointer): String;
var
  B: Byte;
{$IFDEF UNICODE}
{$IFDEF NEXTGEN}
  AStr: TBytes;
{$ELSE !NEXTGEN}
  AStr: AnsiString;
{$ENDIF NEXTGEN}
{$ENDIF}
begin
  B := Byte(P^);
{$IFDEF UNICODE}
  SetLength(AStr, B);
  P := Pointer(NativeInt(P) + 1);
{$IFDEF NEXTGEN}
  Move(P^, AStr[0], Integer(B));
  Result := Tencoding.UTF8.GetString(AStr);
{$ELSE !NEXTGEN}
  Move(P^, AStr[1], Integer(B));
  Result := UTF8ToString(RawUTF8(AStr));
{$ENDIF NEXTGEN}
{$ELSE}
  SetLength(Result, B);
  P := Pointer(NativeInt(P) + 1);
  Move(P^, Result[1], Integer(B));
{$ENDIF}
  P := Pointer(NativeInt(P) + B);
end;

procedure GetDynArrayElTypeInfo(typeInfo: PTypeInfo; var EltInfo: PTypeInfo; var Dims: Integer);
var
  S: string;
  P: Pointer;
  ppInfo: PPTypeInfo;
  Info: PTypeInfo;
  CleanupInfo: Boolean;
begin
  CleanupInfo := False;
  Dims := 0;
  P := Pointer(typeInfo);
  ReadByte(P); { kind }
  S := ReadString(P); { symname }
  ReadLong(P); { elsize }
  ppInfo := ReadPointer(P);

  { Here we rely on Cleanup TypeInfo. However, that's not
    reliable, specially in the case of C++ where the concept
    of cleanup is muddled since the Dynamic Array class
    destructor handles the clean up. Hence, we'll handle both styles
    of RTTI }
  if (ppInfo <> nil) then
  begin
    CleanupInfo := True;
    Info := ppInfo^;
    if Info.Kind = tkDynArray then
    begin
      GetDynArrayElTypeInfo(Info, EltInfo, Dims);
    end;
  end;

  ReadLong(P); { vartype }
  ppInfo := ReadPointer(P); { elttype, even if not destructable, 0 if type has no RTTI }
  if ppInfo <> nil then
  begin
    EltInfo := ppInfo^;
    if not CleanupInfo then
    begin
      Info := EltInfo;
      if Info.Kind = tkDynArray then
        GetDynArrayElTypeInfo(Info, EltInfo, Dims);
    end;
  end;
  Inc(Dims);
end;

// ======================================================================================================================
{$IFNDEF SystemJSON}

function stringArrayToJson(o: Pointer): TDocVariantData;
var
  strArray: TStringDynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  strArray := TStringDynArray(o);
  jo.Init();
  for I := 0 to length(strArray) - 1 do
  begin
    jo.AddItem(strArray[I]);
  end;
  Result := jo;
end;

function booleanArrayToJson(o: Pointer): TDocVariantData;
var
  booleanArray: TBooleanDynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  booleanArray := TBooleanDynArray(o);
  jo.Init();
  for I := 0 to length(booleanArray) - 1 do
  begin
    jo.AddItem(booleanArray[I]);
  end;
  Result := jo;
end;

function enumerationArrayToJson(o: Pointer): TDocVariantData;
var
  enumerationArray: TByteDynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  enumerationArray := TByteDynArray(o);
  jo.Init();
  for I := 0 to length(enumerationArray) - 1 do
  begin
    jo.AddItem(enumerationArray[I]);
  end;
  Result := jo;
end;

function floatArrayToJson(o: Pointer): TDocVariantData;
var
  floatArray: TDoubleDynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  floatArray := TDoubleDynArray(o);
  jo.Init();
  for I := 0 to length(floatArray) - 1 do
  begin
    jo.AddItem(floatArray[I]);
  end;
  Result := jo;
end;

function int64ArrayToJson(o: Pointer): TDocVariantData;
var
  intArray: TInt64DynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  intArray := TInt64DynArray(o);
  jo.Init();
  for I := 0 to length(intArray) - 1 do
  begin
    jo.AddItem(intArray[I]);
  end;
  Result := jo;
end;

function intArrayToJson(o: Pointer): TDocVariantData;
var
  intArray: TIntegerDynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  intArray := TIntegerDynArray(o);
  jo.Init();
  for I := 0 to length(intArray) - 1 do
  begin
    jo.AddItem(intArray[I]);
  end;
  Result := jo;
end;

function objectArrayToJson(o: Pointer): TDocVariantData;
var
  objectArray: TObjectDynArray;
  I: Integer;
  jo: TDocVariantData;
begin
  objectArray := TObjectDynArray(o);
  jo.Init();
  for I := 0 to length(objectArray) - 1 do
  begin
    jo.AddItem(_Json(S2U(ObjectToJsonString(objectArray[I]))));
  end;
  Result := jo;
end;

function jsonToEnumerationArray(SuperArray: TDocVariantData): TByteDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    Result[I] := SuperArray.Value[I];
  end;
end;

function jsonToFloatArray(SuperArray: TDocVariantData): TDoubleDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    Result[I] := SuperArray.Value[I];
  end;
end;

function jsonToint64Array(SuperArray: TDocVariantData): TInt64DynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    Result[I] := SuperArray.Value[I];
  end;
end;

function jsonToIntArray(SuperArray: TDocVariantData): TIntegerDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    Result[I] := SuperArray.Value[I];
  end;
end;

function jsonToObjectArray(c: TClass; SuperArray: TDocVariantData): TObjectArray;
var
  I: Integer;
  Obj: TObject;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    Obj := c.Create;
    if JsonToObject(SuperArray.Value[I], Obj) then
      Result[I] := Obj
    else
      FreeAndNil(Obj);
  end;
end;

function jsonToStringArray(SuperArray: TDocVariantData): TStringDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    try
      Result[I] := UTF8ToString(RawUTF8(SuperArray.Value[I]));
    except
      Result[I] := '';
    end;
  end;
end;

{$ELSE}

function stringArrayToJson(o: Pointer): TJSONArray;
var
  strArray: TStringDynArray;
  I: Integer;
  jo: TJSONArray;
begin
  strArray := TStringDynArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(strArray) - 1 do
  begin
    jo.Add(strArray[I]);
  end;
  Result := jo;
end;

function booleanArrayToJson(o: Pointer): TJSONArray;
var
  booleanArray: TBooleanDynArray;
  I: Integer;
  jo: TJSONArray;
begin
  booleanArray := TBooleanDynArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(booleanArray) - 1 do
  begin
    jo.Add(booleanArray[I]);
  end;
  Result := jo;
end;

function enumerationArrayToJson(o: Pointer): TJSONArray;
var
  enumerationArray: TByteDynArray;
  I: Integer;
  jo: TJSONArray;
begin
  enumerationArray := TByteDynArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(enumerationArray) - 1 do
  begin
    jo.Add(enumerationArray[I]);
  end;
  Result := jo;
end;

function floatArrayToJson(o: Pointer): TJSONArray;
var
  floatArray: TDoubleDynArray;
  I: Integer;
  jo: TJSONArray;
begin
  floatArray := TDoubleDynArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(floatArray) - 1 do
  begin
    jo.Add(floatArray[I]);
  end;
  Result := jo;
end;

function int64ArrayToJson(o: Pointer): TJSONArray;
var
  intArray: TInt64DynArray;
  I: Integer;
  jo: TJSONArray;
begin
  intArray := TInt64DynArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(intArray) - 1 do
  begin
    jo.Add(intArray[I]);
  end;
  Result := jo;
end;

function intArrayToJson(o: Pointer): TJSONArray;
var
  intArray: TIntegerDynArray;
  I: Integer;
  jo: TJSONArray;
begin
  intArray := TIntegerDynArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(intArray) - 1 do
  begin
    jo.Add(intArray[I]);
  end;
  Result := jo;
end;

function objectArrayToJson(o: Pointer): TJSONArray;
var
  objectArray: TObjectArray;
  I: Integer;
  jo: TJSONArray;
begin
  objectArray := TObjectArray(o);
  jo := TJSONArray.Create;
  for I := 0 to length(objectArray) - 1 do
  begin
    jo.Add(ObjectToJson(objectArray[I]));
  end;
  Result := jo;
end;

function jsonToEnumerationArray(SuperArray: TJSONArray): TByteDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    if SuperArray.Items[I] <> nil then
      Result[I] := (SuperArray.Items[I] as TJSONNumber).AsInt;
  end;
end;

function jsonToFloatArray(SuperArray: TJSONArray): TDoubleDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    if SuperArray.Items[I] <> nil then
      Result[I] := (SuperArray.Items[I] as TJSONNumber).AsDouble;
  end;
end;

function jsonToint64Array(SuperArray: TJSONArray): TInt64DynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    if SuperArray.Items[I] <> nil then
      Result[I] := (SuperArray.Items[I] as TJSONNumber).AsInt64;
  end;
end;

function jsonToIntArray(SuperArray: TJSONArray): TIntegerDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    if SuperArray.Items[I] <> nil then
      Result[I] := (SuperArray.Items[I] as TJSONNumber).AsInt;
  end;
end;

function jsonToObjectArray(c: TClass; SuperArray: TJSONArray): TObjectArray;
var
  I: Integer;
  Obj: TObject;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    Obj := c.Create;
    if SuperArray.Items[I] <> nil then
    begin
      if JsonToObject((SuperArray.Items[I] as TJSOnObject).ToJSON, Obj) then
        Result[I] := Obj
      else
        FreeAndNil(Obj);
    end;
  end;
end;

function jsonToStringArray(SuperArray: TJSONArray): TStringDynArray;
var
  I: Integer;
begin
  SetLength(Result, SuperArray.Count);
  for I := 0 to SuperArray.Count - 1 do
  begin
    if SuperArray.Items[I] <> nil then
      Result[I] := (SuperArray.Items[I] as TJSONString).Value;
  end;
end;

function ObjectToJson(const AClass: TObject): TJSOnObject;
var
  Count, I: Integer;
  APropList: PPropList;
  APropInfo: PPropInfo;
  JSON: TJSOnObject;
  APropName: string;
  DynArray: Pointer;
  ElemInfo: PTypeInfo;
  Dims: Integer;
  SuperArray: TJSONArray;
begin
  JSON := TJSOnObject.Create;
  if AClass = nil then
    Exit(JSON);
  Count := GetPropList(AClass, APropList);
  if APropList <> nil then
  begin
    try
      for I := 0 to Count - 1 do
      begin
        APropInfo := APropList^[I];
        APropName := System.SysUtils.LowerCase(GetPropName(APropInfo));

        if TBaseObject(AClass).InSkipPropList(APropName) then
          Continue;

        case APropInfo.PropType^.Kind of
          tkClass:
            begin
              JSON.AddPair(APropName, ObjectToJson(GetObjectProp(AClass, APropName)));
            end;
          tkInteger, tkInt64, tkPointer, tkFloat:
            begin
              JSON.AddPair(APropName, TJSONNumber.Create(GetPropValue(AClass, APropName)))
            end;
          tkString, tkUString:
            begin
              JSON.AddPair(APropName, TJSONString.Create(string(GetPropValue(AClass, APropName))));
            end;
          tkEnumeration:
            begin
              // 若是布尔类型
              if SameText(GetTypeName(APropInfo.PropType^), 'boolean') then
              begin
                JSON.AddPair(APropName, TJSONBool.Create(Boolean(GetPropValue(AClass, APropName))));
              end
              else
                JSON.AddPair(APropName, TJSONNumber.Create(GetOrdProp(AClass, APropName)));
            end;
          tkDynArray:
            begin
              // 数组
              SuperArray := nil;
              DynArray := GetDynArrayProp(AClass, APropName);
              GetDynArrayElTypeInfo(APropInfo.PropType^, ElemInfo, Dims);
              case ElemInfo^.Kind of
                tkInteger:
                  begin
                    // 整型数组
                    SuperArray := intArrayToJson(DynArray);
                  end;
                tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
                  // 字符串数组
                  SuperArray := stringArrayToJson(DynArray);
                tkFloat:
                  begin
                    // 浮点型数组
                    SuperArray := floatArrayToJson(DynArray)
                  end;
                tkEnumeration:
                  begin
                    // 枚举型数组
                    SuperArray := enumerationArrayToJson(DynArray);
                  end;
                tkInt64:
                  begin
                    // 长整型数组
                    SuperArray := int64ArrayToJson(DynArray);
                  end;
                tkClass:
                  begin
                    // 实例数组
                    SuperArray := objectArrayToJson(DynArray);
                  end;
              end;
              JSON.AddPair(APropName, SuperArray);
            end;
        end;
      end;
    finally
      FreeMem(APropList);
    end;
  end;
  Result := JSON;
end;

{$ENDIF}

// ======================================================================================================================
function JsonToObject(const AJsonData: string; const AClass: TClass): TObject;
begin
  Result := AClass.Create;
  if not JsonToObject(AJsonData, Result) then
    FreeAndNil(Result);
end;

function JsonToObject(const AJsonData: string; const AObject: TObject): Boolean;
{$IFNDEF SystemJSON}
var
  I, Count: Integer;
  APropList: PPropList;
  APropInfo: PPropInfo;
  JSON: TDocVariantData;
  APropName: string;
  ChildObj: TObject;
  SuperArray: TDocVariantData;
  ElemInfo: PTypeInfo;
  Dims: Integer;
  TypeData: PTypeData;
begin
  Result := False;

  Count := GetPropList(AObject, APropList);
  if APropList = nil then
    Exit;
  try
    if not JSON.InitJSON(S2U((AJsonData)), [dvoReturnNullForUnknownProperty]) then
      Exit;
    try
      for I := 0 to Count - 1 do
      begin
        APropInfo := APropList^[I];
        APropName := System.SysUtils.LowerCase(GetPropName(APropInfo));
        case APropInfo.PropType^.Kind of
          tkClass:
            begin
              ChildObj := GetObjectProp(AObject, APropName);
              if (ChildObj = nil) and (U2S(JSON.U[S2U(APropName)]) <> '') and (U2S(JSON.U[S2U(APropName)]) <> '{}') then
                ChildObj := APropInfo.PropType^.TypeData.ClassType.Create;
              if (ChildObj <> nil) and JsonToObject(U2S(JSON.U[S2U(APropName)]), ChildObj) then
                SetObjectProp(AObject, APropName, ChildObj);
            end;
          tkInteger, tkPointer:
            begin
              SetPropValue(AObject, APropName, JSON.I[S2U(APropName)]);
            end;
          tkInt64:
            begin
              SetInt64Prop(AObject, APropName, JSON.I[S2U(APropName)]);
            end;
          tkFloat:
            begin
              SetPropValue(AObject, APropName, JSON.D[S2U(APropName)]);
            end;
          tkString, tkUString:
            begin
              SetPropValue(AObject, APropName, U2S(JSON.U[S2U(APropName)]));
            end;
          tkEnumeration:
            begin
              // 若是布尔类型
              if SameText(GetTypeName(APropInfo.PropType^), 'boolean') then
              begin
                SetPropValue(AObject, APropName, JSON.I[S2U(APropName)] <> 0);
              end
              else
                SetOrdProp(AObject, APropName, JSON.I[S2U(APropName)]);
            end;
          tkDynArray:
            begin
              // 数组
              if SuperArray.InitJSON(JSON.U[S2U(APropName)], [dvoReturnNullForUnknownProperty]) then
              begin
                GetDynArrayElTypeInfo(APropInfo.PropType^, ElemInfo, Dims);
                case ElemInfo.Kind of
                  tkInteger:
                    begin
                      // 整型 数组
                      SetDynArrayProp(AObject, APropName, jsonToIntArray(SuperArray));
                    end;
                  tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
                    begin
                      // 字符串 数组
                      SetDynArrayProp(AObject, APropName, jsonToStringArray(SuperArray));
                    end;
                  tkFloat:
                    begin
                      // 浮点型 数组
                      SetDynArrayProp(AObject, APropName, jsonToFloatArray(SuperArray));
                    end;
                  tkEnumeration:
                    begin
                      // 枚举型 数组
                      SetDynArrayProp(AObject, APropName, jsonToEnumerationArray(SuperArray));
                    end;
                  tkInt64:
                    begin
                      // 长整型数组
                      SetDynArrayProp(AObject, APropName, jsonToint64Array(SuperArray));
                    end;
                  tkClass:
                    begin
                      // 实例 数组
                      TypeData := GetTypeData(ElemInfo);
                      SetDynArrayProp(AObject, APropName, jsonToObjectArray(TypeData.ClassType, SuperArray));
                    end;
                end;
                SuperArray.Clear;
              end;
            end;
        end;
      end;
      Result := True;
    except
      on E: Exception do
      begin
        raise Exception.Create(Format('JsonToObject Exception,Json:%s - PropName:%s', [AJsonData, APropName]));
      end;
    end;
  finally
    FreeMem(APropList);
  end;
end;
{$ELSE}

var
  I, Count: Integer;
  APropList: PPropList;
  APropInfo: PPropInfo;
  APropName: string;
  ChildObj: TObject;
  JSON: TJSOnObject;
  Value: TJSONValue;
  SuperArray: TJSONArray;
  ElemInfo: PTypeInfo;
  Dims: Integer;
  TypeData: PTypeData;
begin
  Result := False;
  JSON := TJSOnObject.ParseJSONValue(AJsonData) as TJSOnObject;
  if JSON = nil then
  begin
    raise Exception.Create('解析JSON失败:' + AJsonData);
    Exit;
  end;
  try
    Count := GetPropList(AObject, APropList);
    if APropList = nil then
      Exit;
    try
      try
        for I := 0 to Count - 1 do
        begin
          APropInfo := APropList^[I];
          APropName := System.SysUtils.LowerCase(GetPropName(APropInfo));
          Value := JSON.Values[APropName];
          if Value = nil then
            Continue;
          case APropInfo.PropType^.Kind of
            tkClass:
              begin
                ChildObj := GetObjectProp(AObject, APropName);
                if (ChildObj = nil) and ((Value as TJSOnObject).Count > 0) then
                  ChildObj := APropInfo.PropType^.TypeData.ClassType.Create;
                if (ChildObj <> nil) and JsonToObject((Value as TJSOnObject).ToJSON, ChildObj) then
                  SetObjectProp(AObject, APropName, ChildObj);
              end;
            tkInteger, tkPointer:
              begin
                SetPropValue(AObject, APropName, (Value as TJSONNumber).AsInt);
              end;
            tkInt64:
              begin
                SetPropValue(AObject, APropName, (Value as TJSONNumber).AsInt64);
              end;
            tkFloat:
              begin
                SetPropValue(AObject, APropName, (Value as TJSONNumber).AsDouble);
              end;
            tkString, tkUString:
              begin
                SetPropValue(AObject, APropName, (Value as TJSONString).Value);
              end;
            tkEnumeration:
              begin
                // 若是布尔类型
                if SameText(GetTypeName(APropInfo.PropType^), 'boolean') then
                begin
                  SetPropValue(AObject, APropName, (Value as TJSONBool).AsBoolean);
                end
                else
                  SetPropValue(AObject, APropName, (Value as TJSONNumber).AsInt);
              end;
            tkDynArray:
              begin
                // 数组
                SuperArray := Value as TJSONArray;
                GetDynArrayElTypeInfo(APropInfo.PropType^, ElemInfo, Dims);
                case ElemInfo.Kind of
                  tkInteger:
                    begin
                      // 整型 数组
                      SetDynArrayProp(AObject, APropName, jsonToIntArray(SuperArray));
                    end;
                  tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
                    begin
                      // 字符串 数组
                      SetDynArrayProp(AObject, APropName, jsonToStringArray(SuperArray));
                    end;
                  tkFloat:
                    begin
                      // 浮点型 数组
                      SetDynArrayProp(AObject, APropName, jsonToFloatArray(SuperArray));
                    end;
                  tkEnumeration:
                    begin
                      // 枚举型 数组
                      SetDynArrayProp(AObject, APropName, jsonToEnumerationArray(SuperArray));
                    end;
                  tkInt64:
                    begin
                      // 长整型数组
                      SetDynArrayProp(AObject, APropName, jsonToint64Array(SuperArray));
                    end;
                  tkClass:
                    begin
                      // 实例 数组
                      TypeData := GetTypeData(ElemInfo);
                      SetDynArrayProp(AObject, APropName, jsonToObjectArray(TypeData.ClassType, SuperArray));
                    end;
                end;
              end;
          end;
        end;
        Result := True;
      except
        on E: Exception do
        begin
          raise Exception.Create(Format('JsonToObject Exception,Json:%s - PropName:%s', [AJsonData, APropName]));
        end;
      end;
    finally
      FreeMem(APropList);
    end;
  finally
    JSON.Free;
  end;
end;
{$ENDIF}

function ObjectToJsonString(const AClass: TObject): string;
{$IFNDEF SystemJSON}
var
  Count, I: Integer;
  APropList: PPropList;
  APropInfo: PPropInfo;
  JSON: TDocVariantData;
  APropName: string;
  DynArray: Pointer;
  ElemInfo: PTypeInfo;
  Dims: Integer;
  SuperArray: TDocVariantData;
begin
  JSON.Init;
  Result := U2S(JSON.ToJSON);
  if AClass = nil then
    Exit;
  Count := GetPropList(AClass, APropList);
  if APropList <> nil then
  begin
    try
      for I := 0 to Count - 1 do
      begin
        APropInfo := APropList^[I];
        APropName := System.SysUtils.LowerCase(GetPropName(APropInfo));

        if TBaseObject(AClass).InSkipPropList(APropName) then
          Continue;

        case APropInfo.PropType^.Kind of
          tkClass:
            begin
              JSON.Value[S2U(APropName)] := _Json(RawUTF8(ObjectToJsonString(GetObjectProp(AClass, APropName))));
              // JSON.U[S2U(APropName)] := RawUTF8(ObjectToJsonString(GetObjectProp(AClass, APropName)));
            end;
          tkInteger, tkInt64, tkPointer:
            begin
              JSON.I[S2U(APropName)] := Int64(GetPropValue(AClass, APropName));
            end;
          tkFloat:
            begin
              JSON.D[S2U(APropName)] := GetPropValue(AClass, APropName);
            end;
          tkString, tkUString:
            begin
              JSON.U[S2U(APropName)] := StringToUTF8(GetPropValue(AClass, APropName));
            end;
          tkEnumeration:
            begin
              // 若是布尔类型
              if SameText(GetTypeName(APropInfo.PropType^), 'boolean') then
              begin
                JSON.B[S2U(APropName)] := Boolean(GetPropValue(AClass, APropName));
              end
              else
                JSON.I[S2U(APropName)] := GetOrdProp(AClass, APropName);
            end;
          tkDynArray:
            begin
              // 数组
              DynArray := GetDynArrayProp(AClass, APropName);
              GetDynArrayElTypeInfo(APropInfo.PropType^, ElemInfo, Dims);
              case ElemInfo^.Kind of
                tkInteger:
                  begin
                    // 整型数组
                    SuperArray := intArrayToJson(DynArray);
                  end;
                tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
                  // 字符串数组
                  SuperArray := stringArrayToJson(DynArray);
                tkFloat:
                  begin
                    // 浮点型数组
                    SuperArray := floatArrayToJson(DynArray)
                  end;
                tkEnumeration:
                  begin
                    // 枚举型数组
                    SuperArray := enumerationArrayToJson(DynArray);
                  end;
                tkInt64:
                  begin
                    // 长整型数组
                    SuperArray := int64ArrayToJson(DynArray);
                  end;
                tkClass:
                  begin
                    // 实例数组
                    SuperArray := objectArrayToJson(DynArray);
                  end;
              end;
              if SuperArray.Count > 0 then
                JSON.Value[S2U(APropName)] := _Json(SuperArray.ToJSON)
              else
                JSON.Value[S2U(APropName)] := _Json('[]');
            end;
        end;
      end;
      Result := U2S(JSON.ToJSON());
    finally
      FreeMem(APropList);
    end;
  end;
end;
{$ELSE}

var
  AJSOnObject: TJSOnObject;
begin
  AJSOnObject := ObjectToJson(AClass);
  try
    Result := AJSOnObject.ToJSON;
  finally
    AJSOnObject.Free;
  end;
end;

{$ENDIF}

{ TBaseObject }
procedure TBaseObject.AfterConstruction;
begin
  inherited;
  FSkipPropList := TStringList.Create;
end;

function TBaseObject.AssignFromJson(const AJsonString: string): Boolean;
begin
  Result := JsonToObject(AJsonString, Self);
end;

function TBaseObject.GetJsonString: string;
begin
  Result := ObjectToJsonString(Self);
end;

procedure TBaseObject.AddSkipProp(const APropName: string);
begin
  FSkipPropList.Add(APropName);
end;

procedure TBaseObject.AutoDestroy;
var
  Count, I, J: Integer;
  APropList: PPropList;
  APropInfo: PPropInfo;
  APropName: string;
  AObj: TObject;
  DynArray: Pointer;
  ElemInfo: PTypeInfo;
  Dims: Integer;
  objectArray: TObjectArray;
begin
  APropList := nil;
  Count := GetPropList(Self, APropList);
  if APropList <> nil then
  begin
    try
      for I := 0 to Count - 1 do
      begin
        APropInfo := APropList^[I];
        APropName := System.SysUtils.LowerCase(GetPropName(APropInfo));
        case APropInfo.PropType^.Kind of
          tkClass:
            begin
              AObj := GetObjectProp(Self, APropName);
              if AObj <> nil then
              begin
                FreeAndNil(AObj);
                SetObjectProp(Self, APropName, nil);
              end;
            end;
          tkDynArray:
            begin
              // 数组
              DynArray := GetDynArrayProp(Self, APropName);
              GetDynArrayElTypeInfo(APropInfo.PropType^, ElemInfo, Dims);
              if ElemInfo^.Kind = tkClass then
              begin
                objectArray := TObjectArray(DynArray);
                for J := Low(objectArray) to High(objectArray) do
                begin
                  objectArray[J].Free;
                end;
              end;
            end;
        end;
      end;
    finally
      FreeMem(APropList);
    end;
  end;

end;

procedure TBaseObject.BeforeDestruction;
begin
  inherited;
  FSkipPropList.Free;
end;

function TBaseObject.CopyFrom(const ASrcObj: TBaseObject): Boolean;
begin
  Result := AssignFromJson(ASrcObj.JsonString);
end;

constructor TBaseObject.Create;
begin

end;

constructor TBaseObject.Create(const AJsonString: string);
begin
  AssignFromJson(AJsonString);
end;

destructor TBaseObject.Destroy;
begin
  AutoDestroy;
  inherited;
end;

function TBaseObject.InSkipPropList(const APropName: string): Boolean;
begin
  Result := FSkipPropList.IndexOf(APropName) >= 0;
end;

function TBaseObject.LoadFormFile(const AFileName: string): Boolean;
var
  AStringStream: TStringStream;
begin
  try
    if not FileExists(AFileName) then
      Exit(False);
    AStringStream := TStringStream.Create;
    try
      AStringStream.LoadFromFile(AFileName);
      Result := AssignFromJson(AStringStream.DataString);
    finally
      AStringStream.Free;
    end;
  except
    on E: Exception do
    begin
      raise Exception.Create(E.Message);
    end;
  end;
end;

function TBaseObject.SaveToFile(const AFileName: string): Boolean;
var
  AStringStream: TStringStream;
begin
  try
    AStringStream := TStringStream.Create;
    try
      AStringStream.WriteString(JsonString);
      AStringStream.SaveToFile(AFileName);
      Result := True;
    finally
      AStringStream.Free;
    end;
  except
    on E: Exception do
    begin
      raise Exception.Create(E.Message);
    end;
  end;
end;

end.

调用demo

写了个简单的Demo,代码如下:

type
  TFriendItem = class(TBaseObject)
  private
    FName: string;
    FAge: Integer;
  published
    property Age: Integer read FAge write FAge;
    property Name: string read FName write FName;
  end;

  TDataConfig = class(TBaseObject)
  private
    FName: string;
    FID: Integer;
    FFriends: TArray<TFriendItem>;
  published
    property ID: Integer read FID write FID;
    property Name: string read FName write FName;
    property Friends: TArray<TFriendItem> read FFriends write FFriends;
  end;

var
  Form7: TForm7;

implementation

{$R *.dfm}

procedure TForm7.Button1Click(Sender: TObject);
var
  I: Integer;
  ADataConfig: TDataConfig;
  AFriends: TArray<TFriendItem>;
begin
  ADataConfig := TDataConfig.Create;
  try
    ADataConfig.ID := 1;
    ADataConfig.Name := '测试啊';
    SetLength(AFriends, 10);
    for I := 0 to 9 do
    begin
      AFriends[I] := TFriendItem.Create;
      AFriends[I].Age := I;
      AFriends[I].Name := '朋友' + IntToStr(I);
    end;
    ADataConfig.Friends := AFriends;
    Memo1.Text := ADataConfig.JsonString;
  finally
    ADataConfig.Free;
  end;
end;

procedure TForm7.Button2Click(Sender: TObject);
var
  I: Integer;
  ADataConfig: TDataConfig;
  AFriends: TArray<TFriendItem>;
begin
  Memo1.Lines.Add('反序列化结果如下:---------------------------------------');
  ADataConfig := TDataConfig.Create;
  try
    if ADataConfig.AssignFromJson(Memo1.Text) then
    begin
      Memo1.Lines.Add(ADataConfig.ID.ToString);
      Memo1.Lines.Add(ADataConfig.Name);
      for I := Low(ADataConfig.Friends) to High(ADataConfig.Friends) do
      begin
        Memo1.Lines.Add(Format('%d - %s', [ADataConfig.Friends[I].Age, ADataConfig.Friends[I].Name]));
      end;
    end
    else
      Memo1.Lines.Add('反序列化失败');
  finally
    ADataConfig.Free;
  end;
end;


请扫码加入QQ群
微信二维码
不容错过
Powered By Z-BlogPHP