Browse Source

[jsonSerializer] removed rtticontext.free

Exilon 5 years ago
parent
commit
c65569c5a0
1 changed files with 160 additions and 191 deletions
  1. 160 191
      Quick.Json.Serializer.pas

+ 160 - 191
Quick.Json.Serializer.pas

@@ -7,7 +7,7 @@
   Author      : Kike Pérez
   Author      : Kike Pérez
   Version     : 1.11
   Version     : 1.11
   Created     : 21/05/2018
   Created     : 21/05/2018
-  Modified    : 12/03/2020
+  Modified    : 22/03/2020
 
 
   This file is part of QuickLib: https://github.com/exilon/QuickLib
   This file is part of QuickLib: https://github.com/exilon/QuickLib
 
 
@@ -335,72 +335,68 @@ var
   propobj : TObject;
   propobj : TObject;
 begin
 begin
   rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
   rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
-  try
-    for rField in rRec.GetFields do
-    begin
-      rValue := nil;
-      //member := TJSONPair(aJson.GetValue(rField.Name));
-      member := GetJsonPairValueByName(aJson,rField.Name);
-      if member <> nil then
-      case rField.FieldType.TypeKind of
-        tkDynArray :
-          begin
-            jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
-            try
-              rValue := DeserializeDynArray(rField.FieldType.Handle,aObject,jArray);
-            finally
-              jArray.Free;
-            end;
-          end;
-        tkClass :
-          begin
-            //if (member.JsonValue is TJSONObject) then
-            begin
-              propobj := rField.GetValue(@aRecord).AsObject;
-              json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
-              try
-                if propobj = nil then
-                begin
-                  objClass := rField.FieldType.Handle^.TypeData.ClassType;// aProperty.PropertyType.Handle^.TypeData.ClassType;
-                  rValue := DeserializeClass(objClass,json);
-                end
-                else
-                begin
-                  DeserializeObject(propobj,json);
-                end;
-              finally
-                json.Free;
-              end;
-            end
+  for rField in rRec.GetFields do
+  begin
+    rValue := nil;
+    //member := TJSONPair(aJson.GetValue(rField.Name));
+    member := GetJsonPairValueByName(aJson,rField.Name);
+    if member <> nil then
+    case rField.FieldType.TypeKind of
+      tkDynArray :
+        begin
+          jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
+          try
+            rValue := DeserializeDynArray(rField.FieldType.Handle,aObject,jArray);
+          finally
+            jArray.Free;
           end;
           end;
-        tkRecord :
+        end;
+      tkClass :
+        begin
+          //if (member.JsonValue is TJSONObject) then
           begin
           begin
+            propobj := rField.GetValue(@aRecord).AsObject;
             json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
             json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
             try
             try
-              rValue := DeserializeRecord(rField.GetValue(aRecord.GetReferenceToRawData),aObject,json);
+              if propobj = nil then
+              begin
+                objClass := rField.FieldType.Handle^.TypeData.ClassType;// aProperty.PropertyType.Handle^.TypeData.ClassType;
+                rValue := DeserializeClass(objClass,json);
+              end
+              else
+              begin
+                DeserializeObject(propobj,json);
+              end;
             finally
             finally
               json.Free;
               json.Free;
             end;
             end;
           end
           end
-      else
-        begin
-          //rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJson);
-          //avoid return unicode escaped chars if string
-          if rField.FieldType.TypeKind in [tkString, tkLString, tkWString, tkUString] then
-            {$IFDEF DELPHIRX10_UP}
-            rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,TJsonValue(member).value)
-            {$ELSE}
-            rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.JsonString.ToString)
-            {$ENDIF}
-            else rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJSON);
         end;
         end;
+      tkRecord :
+        begin
+          json := TJSONObject.ParseJSONValue(member.ToJson) as TJSONObject;
+          try
+            rValue := DeserializeRecord(rField.GetValue(aRecord.GetReferenceToRawData),aObject,json);
+          finally
+            json.Free;
+          end;
+        end
+    else
+      begin
+        //rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJson);
+        //avoid return unicode escaped chars if string
+        if rField.FieldType.TypeKind in [tkString, tkLString, tkWString, tkUString] then
+          {$IFDEF DELPHIRX10_UP}
+          rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,TJsonValue(member).value)
+          {$ELSE}
+          rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.JsonString.ToString)
+          {$ENDIF}
+          else rValue := DeserializeType(aObject,rField.FieldType.TypeKind,rField.FieldType.Handle,member.ToJSON);
       end;
       end;
-      if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
     end;
     end;
-    Result := aRecord;
-  finally
-    ctx.Free;
+    if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
   end;
   end;
+  Result := aRecord;
 end;
 end;
 {$ENDIF}
 {$ENDIF}
 
 
@@ -444,39 +440,35 @@ begin
 
 
   try
   try
     rType := ctx.GetType(aObject.ClassInfo);
     rType := ctx.GetType(aObject.ClassInfo);
-    try
-      for rProp in rType.GetProperties do
+    for rProp in rType.GetProperties do
+    begin
+      {$IFNDEF FPC}
+      if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
+          or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
+      {$ENDIF}
       begin
       begin
-        {$IFNDEF FPC}
-        if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
-            or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
-        {$ENDIF}
+        if ((rProp.IsWritable) or (rProp.Name = 'List')) and (IsAllowedProperty(aObject,rProp.Name)) then
         begin
         begin
-          if ((rProp.IsWritable) or (rProp.Name = 'List')) and (IsAllowedProperty(aObject,rProp.Name)) then
+          propertyname := rProp.Name;
+          {$IFNDEF FPC}
+          for attr in rProp.GetAttributes do if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
+          if rProp.Name = 'List' then
           begin
           begin
-            propertyname := rProp.Name;
-            {$IFNDEF FPC}
-            for attr in rProp.GetAttributes do if attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
-            if rProp.Name = 'List' then
-            begin
-              Result := DeserializeList(Result,propertyname,aJson);
-            end
-            else if (rProp.GetValue(aObject).IsObject) and (IsGenericList(rProp.GetValue(aObject).AsObject)) then
-            begin
-              DeserializeList(rProp.GetValue(aObject).AsObject,'List',TJSONObject(aJson.GetValue(propertyname)));
-            end
-            else if (not rProp.GetValue(aObject).IsObject) and (IsGenericXArray(rProp.GetValue(aObject){$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
-            begin
-              DeserializeXArray(Result,rProp.GetValue(aObject),rProp,propertyname,aJson);
-            end
-            else
-            {$ENDIF}
-            Result := DeserializeProperty(Result,propertyname,rProp,aJson);
-          end;
+            Result := DeserializeList(Result,propertyname,aJson);
+          end
+          else if (rProp.GetValue(aObject).IsObject) and (IsGenericList(rProp.GetValue(aObject).AsObject)) then
+          begin
+            DeserializeList(rProp.GetValue(aObject).AsObject,'List',TJSONObject(aJson.GetValue(propertyname)));
+          end
+          else if (not rProp.GetValue(aObject).IsObject) and (IsGenericXArray(rProp.GetValue(aObject){$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
+          begin
+            DeserializeXArray(Result,rProp.GetValue(aObject),rProp,propertyname,aJson);
+          end
+          else
+          {$ENDIF}
+          Result := DeserializeProperty(Result,propertyname,rProp,aJson);
         end;
         end;
       end;
       end;
-    finally
-      ctx.Free;
     end;
     end;
   except
   except
     on E : Exception do
     on E : Exception do
@@ -505,12 +497,9 @@ begin
   Result := aObject;
   Result := aObject;
 
 
   rType := ctx.GetType(aObject.ClassInfo);
   rType := ctx.GetType(aObject.ClassInfo);
-  try
-    rProp := rType.GetProperty('List');
-    if rProp = nil then Exit;
-  finally
-    ctx.Free;
-  end;
+  rProp := rType.GetProperty('List');
+  if rProp = nil then Exit;
+
 
 
   member := GetJsonPairValueByName(aJson,aName);
   member := GetJsonPairValueByName(aJson,aName);
   if member = nil then jArray := TJSONObject.ParseJSONValue(aJson.ToJSON) as TJSONArray
   if member = nil then jArray := TJSONObject.ParseJSONValue(aJson.ToJSON) as TJSONArray
@@ -566,28 +555,24 @@ var
   jArray : TJSONArray;
   jArray : TJSONArray;
 begin
 begin
   rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
   rRec := ctx.GetType(aRecord.TypeInfo).AsRecord;
-  try
-    rfield := rRec.GetField('fArray');
-    if rfield <> nil then
+  rfield := rRec.GetField('fArray');
+  if rfield <> nil then
+  begin
+    rValue := nil;
+    //member := TJSONPair(aJson.GetValue(rField.Name));
+    member := GetJsonPairValueByName(aJson,aPropertyName);
+    if (member <> nil) and (rField.FieldType.TypeKind = tkDynArray) then
     begin
     begin
-      rValue := nil;
-      //member := TJSONPair(aJson.GetValue(rField.Name));
-      member := GetJsonPairValueByName(aJson,aPropertyName);
-      if (member <> nil) and (rField.FieldType.TypeKind = tkDynArray) then
-      begin
-        jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
-        try
-          rValue := DeserializeDynArray(rField.FieldType.Handle,nil,jArray);
-        finally
-          jArray.Free;
-        end;
+      jArray := TJSONObject.ParseJSONValue(member.ToJSON) as TJSONArray;
+      try
+        rValue := DeserializeDynArray(rField.FieldType.Handle,nil,jArray);
+      finally
+        jArray.Free;
       end;
       end;
     end;
     end;
-    if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
-    aProperty.SetValue(Instance,aRecord);
-  finally
-    ctx.Free;
   end;
   end;
+  if not rValue.IsEmpty then rField.SetValue(aRecord.GetReferenceToRawData,rValue);
+  aProperty.SetValue(Instance,aRecord);
 end;
 end;
 {$ENDIF}
 {$ENDIF}
 
 
@@ -1091,64 +1076,60 @@ begin
   Result := TJSONObject.Create;
   Result := TJSONObject.Create;
   try
   try
     rType := ctx.GetType(aObject.ClassInfo);
     rType := ctx.GetType(aObject.ClassInfo);
-    try
-      //s := rType.ToString;
-      for rProp in rType.GetProperties do
+    //s := rType.ToString;
+    for rProp in rType.GetProperties do
+    begin
+      ExcludeSerialize := False;
+      propertyname := rProp.Name;
+      {$IFNDEF FPC}
+      comment := '';
+      for attr in rProp.GetAttributes do
       begin
       begin
-        ExcludeSerialize := False;
-        propertyname := rProp.Name;
-        {$IFNDEF FPC}
-        comment := '';
-        for attr in rProp.GetAttributes do
-        begin
-          if attr is TNotSerializableProperty then ExcludeSerialize := True
-          else if attr is TCommentProperty then comment := TCommentProperty(attr).Comment
-          else if  attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
-        end;
-        if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
-            or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
-        {$ENDIF}
+        if attr is TNotSerializableProperty then ExcludeSerialize := True
+        else if attr is TCommentProperty then comment := TCommentProperty(attr).Comment
+        else if  attr is TCustomNameProperty then propertyname := TCustomNameProperty(attr).Name;
+      end;
+      if ((fSerializeLevel = slPublicProperty) and (rProp.PropertyType.IsPublicType))
+          or ((fSerializeLevel = slPublishedProperty) and ((IsPublishedProp(aObject,rProp.Name)) or (rProp.Name = 'List'))) then
+      {$ENDIF}
+      begin
+        if (IsAllowedProperty(aObject,propertyname)) and (not ExcludeSerialize) then
         begin
         begin
-          if (IsAllowedProperty(aObject,propertyname)) and (not ExcludeSerialize) then
+          //add comment as pair
+          {$IFNDEF FPC}
+          if comment <> '' then Result.AddPair(TJSONPair.Create('#Comment#->'+propertyname,Comment));
+          {$ENDIF}
           begin
           begin
-            //add comment as pair
+            propvalue := rProp.GetValue(aObject);
+            if (propvalue.IsObject) and (IsGenericList(propvalue.AsObject)) then
+            begin
+              jpair := Serialize(propertyname,GetPropertyValueFromObject(propvalue.AsObject,'List'));
+            end
             {$IFNDEF FPC}
             {$IFNDEF FPC}
-            if comment <> '' then Result.AddPair(TJSONPair.Create('#Comment#->'+propertyname,Comment));
+            else if (not propvalue.IsObject) and (IsGenericXArray(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
+            begin
+              jpair := Serialize(propertyname,GetFieldValueFromRecord(propvalue,'fArray'));
+            end
             {$ENDIF}
             {$ENDIF}
+            else
             begin
             begin
-              propvalue := rProp.GetValue(aObject);
-              if (propvalue.IsObject) and (IsGenericList(propvalue.AsObject)) then
-              begin
-                jpair := Serialize(propertyname,GetPropertyValueFromObject(propvalue.AsObject,'List'));
-              end
               {$IFNDEF FPC}
               {$IFNDEF FPC}
-              else if (not propvalue.IsObject) and (IsGenericXArray(propvalue{$IFNDEF NEXTGEN}.TypeInfo.Name{$ELSE}.TypeInfo.NameFld.ToString{$ENDIF})) then
-              begin
-                jpair := Serialize(propertyname,GetFieldValueFromRecord(propvalue,'fArray'));
-              end
+              jpair := Serialize(propertyname,propvalue);
+              {$ELSE}
+              jpair := Serialize(aObject,rProp.PropertyType.TypeKind,propertyname);
               {$ENDIF}
               {$ENDIF}
-              else
-              begin
-                {$IFNDEF FPC}
-                jpair := Serialize(propertyname,propvalue);
-                {$ELSE}
-                jpair := Serialize(aObject,rProp.PropertyType.TypeKind,propertyname);
-                {$ENDIF}
-              end;
-              //s := jpair.JsonValue.ToString;
-              if jpair <> nil then
-              begin
-                Result.AddPair(jpair);
-              end
-              else jpair.Free;
             end;
             end;
-            //Result.AddPair(Serialize(rProp.Name,rProp.GetValue(aObject)));
-            //s := Result.ToJSON;
+            //s := jpair.JsonValue.ToString;
+            if jpair <> nil then
+            begin
+              Result.AddPair(jpair);
+            end
+            else jpair.Free;
           end;
           end;
+          //Result.AddPair(Serialize(rProp.Name,rProp.GetValue(aObject)));
+          //s := Result.ToJSON;
         end;
         end;
       end;
       end;
-    finally
-      ctx.Free;
     end;
     end;
   except
   except
     on E : Exception do
     on E : Exception do
@@ -1190,31 +1171,27 @@ begin
         begin
         begin
           jArray := TJSONArray.Create;
           jArray := TJSONArray.Create;
           rDynArray := ctx.GetType(aValue.TypeInfo) as TRTTIDynamicArrayType;
           rDynArray := ctx.GetType(aValue.TypeInfo) as TRTTIDynamicArrayType;
-          try
-            for i := 0 to aValue.GetArrayLength - 1 do
+          for i := 0 to aValue.GetArrayLength - 1 do
+          begin
+            if not GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).IsEmpty then
             begin
             begin
-              if not GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType).IsEmpty then
-              begin
-                jValue := nil;
-                jPair := Serialize(aName,GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType));
-                try
-                  //jValue := TJsonValue(jPair.JsonValue.Clone);
-                  jValue := jPair.JsonValue;
-                  if jValue <> nil then
-                  begin
-                    jArray.AddElement(jValue);
-                    jPair.JsonValue.Owned := False;
-                  end;
-                finally
-                  jPair.Free;
-                  if jValue <> nil then jValue.Owned := True;
+              jValue := nil;
+              jPair := Serialize(aName,GetValue(PPByte(aValue.GetReferenceToRawData)^ + rDynArray.ElementType.TypeSize * i, rDynArray.ElementType));
+              try
+                //jValue := TJsonValue(jPair.JsonValue.Clone);
+                jValue := jPair.JsonValue;
+                if jValue <> nil then
+                begin
+                  jArray.AddElement(jValue);
+                  jPair.JsonValue.Owned := False;
                 end;
                 end;
+              finally
+                jPair.Free;
+                if jValue <> nil then jValue.Owned := True;
               end;
               end;
             end;
             end;
-            Result.JsonValue := jArray;
-          finally
-            ctx.Free;
           end;
           end;
+          Result.JsonValue := jArray;
         end;
         end;
       tkClass :
       tkClass :
         begin         
         begin         
@@ -1286,16 +1263,12 @@ begin
           end
           end
           else
           else
           begin
           begin
-            try
-              json := TJSONObject.Create;
-              for rField in rRec.GetFields do
-              begin
-                json.AddPair(Serialize(rField.name,rField.GetValue(aValue.GetReferenceToRawData)));
-              end;
-              Result.JsonValue := json;
-            finally
-              ctx.Free;
+            json := TJSONObject.Create;
+            for rField in rRec.GetFields do
+            begin
+              json.AddPair(Serialize(rField.name,rField.GetValue(aValue.GetReferenceToRawData)));
             end;
             end;
+            Result.JsonValue := json;
           end;
           end;
         end;
         end;
       tkVariant :
       tkVariant :
@@ -1526,16 +1499,12 @@ begin
       tkRecord :
       tkRecord :
         begin
         begin
           rRec := ctx.GetType(aValue.TypeInfo).AsRecord;
           rRec := ctx.GetType(aValue.TypeInfo).AsRecord;
-          try
-            json := TJSONObject.Create;
-            for rField in rRec.GetFields do
-            begin
-              json.AddPair(Serialize(rField.name,rField.GetValue(aValue.GetReferenceToRawData)));
-            end;
-            Result.JsonValue := json;
-          finally
-            ctx.Free;
+          json := TJSONObject.Create;
+          for rField in rRec.GetFields do
+          begin
+            json.AddPair(Serialize(rField.name,rField.GetValue(aValue.GetReferenceToRawData)));
           end;
           end;
+          Result.JsonValue := json;
         end;
         end;
       {$ENDIF}
       {$ENDIF}
       tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :
       tkMethod, tkPointer, tkClassRef ,tkInterface, tkProcedure :