ソースを参照

* Merging revisions r46329 from trunk:
------------------------------------------------------------------------
r46329 | michael | 2020-08-08 14:36:47 +0200 (Sat, 08 Aug 2020) | 1 line

* Added jdoNullClearsProperty
------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46637 -

michael 5 年 前
コミット
bac46c9d3b
1 ファイル変更58 行追加2 行削除
  1. 58 2
      packages/fcl-json/src/fpjsonrtti.pp

+ 58 - 2
packages/fcl-json/src/fpjsonrtti.pp

@@ -115,7 +115,7 @@ Type
   TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
   TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
   TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
   TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
   TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
   TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
-  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors,jdoIgnoreNulls);
+  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors,jdoIgnoreNulls,jdoNullClearsProperty);
   TJSONDestreamOptions = set of TJSONDestreamOption;
   TJSONDestreamOptions = set of TJSONDestreamOption;
 
 
   TJSONDeStreamer = Class(TJSONFiler)
   TJSONDeStreamer = Class(TJSONFiler)
@@ -134,6 +134,7 @@ Type
     // Try to parse a date.
     // Try to parse a date.
     Function ExtractDateTime(S : String): TDateTime;
     Function ExtractDateTime(S : String): TDateTime;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
+    procedure DoClearProperty(AObject: TObject; PropInfo: PPropInfo); virtual;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
     function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual;
     function DoMapProperty(AObject: TObject; PropInfo: PPropInfo; JSON: TJSONObject): TJSONData; virtual;
     procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
     procedure DoBeforeReadObject(Const JSON: TJSONObject; AObject: TObject); virtual;
@@ -398,8 +399,13 @@ begin
       If B then
       If B then
         exit;
         exit;
       end;
       end;
-    if (PropData.JSONType<>jtNull) or not (jdoIgnoreNulls in Options) then
+    if (PropData.JSONType<>jtNull) then
       DoRestoreProperty(AObject,PropInfo,PropData)
       DoRestoreProperty(AObject,PropInfo,PropData)
+    else if (jdoNullClearsProperty in Options) then
+      DoClearProperty(aObject,PropInfo)
+    else if not (jdoIgnoreNulls in Options) then
+      DoRestoreProperty(AObject,PropInfo,PropData)
+
   except
   except
     On E : Exception do
     On E : Exception do
       If Assigned(FOnPropError) then
       If Assigned(FOnPropError) then
@@ -414,6 +420,56 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TJSONDeStreamer.DoClearProperty(AObject : TObject;PropInfo : PPropInfo);
+
+Var
+  PI : PPropInfo;
+  TI : PTypeInfo;
+  I,J,S : Integer;
+  A : TJSONArray;
+  JS : TJSONStringType;
+begin
+  PI:=PropInfo;
+  TI:=PropInfo^.PropType;
+  case TI^.Kind of
+    tkUnknown :
+      Error(SErrUnknownPropertyKind,[PI^.Name]);
+    tkInteger,
+    tkEnumeration,
+    tkSet,
+    tkChar,
+    tkWChar,
+    tkBool,
+    tkQWord,
+    tkUChar,
+    tkInt64 :
+      SetOrdProp(AObject,PI,0);
+    tkFloat :
+      SetFloatProp(AObject,PI,0.0);
+    tkSString,
+    tkLString,
+    tkAString:
+      SetStrProp(AObject,PI,'');
+    tkWString :
+      SetWideStrProp(AObject,PI,'');
+    tkVariant:
+      SetVariantProp(AObject,PI,Null);
+    tkClass:
+      SetOrdProp(AObject,PI,0);
+    tkUString :
+      SetUnicodeStrProp(AObject,PI,'');
+    tkObject,
+    tkArray,
+    tkRecord,
+    tkInterface,
+    tkDynArray,
+    tkInterfaceRaw,
+    tkProcVar,
+    tkMethod :
+      Error(SErrUnsupportedPropertyKind,[PI^.Name]);
+  end;
+end;
+
 procedure TJSONDeStreamer.DoRestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
 procedure TJSONDeStreamer.DoRestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
 
 
 Var
 Var