泛型和Marshal / UnMarshal。我错过了什么吗？第二部分 :-)

Question

跟进之前的问题： 泛型和编组/解组。我错过了什么？ 在“第一部分”（上述链接）中，TOndrej提供了一个好的解决方案-但在XE2上失败了。 在这里，我提供了修正后的源代码来纠正这个问题。

我感觉有必要再扩展一下这个问题。 所以我想听听大家如何做到这一点：

首先-为了让源代码在XE2和XE2更新1上运行，请进行以下更改：

Marshal.RegisterConverter(TTestObject,
  function (Data: TObject): String // <-- String here
  begin
    Result := T(Data).Marshal.ToString; // <-- ToString here
  end
  );

为什么会这样？我想唯一的原因就是XE2有更多的RTTI信息可用，所以它会尝试对返回的TObject进行编组。我说的对吗？欢迎评论。

更重要的是，这个例子没有实现UnMarshal方法。如果有人能够制作并在此处发布，我会非常感激 :-)

希望您仍然对这个主题有兴趣。

祝好 Bjarne

- Bimmer_R

---

我建议您将问题更加聚焦，不要过于开放，那么您的问题到底是什么？ - Johan

首先，我提供了一个解决之前我遇到的另一个问题的方法。[链接] https://dev59.com/ilvUa4cB1Zd3GeqPupDW其次，我想听听所有感兴趣的人是否有一个简单的UnMarshal方法的解决方案。 - Bimmer_R

不要告诉我 :-)，编辑问题使其更加专注。现在它到处都是... - Johan

希望现在问题更加清晰了 :-) - Bimmer_R

Answer 1

除了回答这个问题，我在这里发布了一个解决方法来回答你之前的问题：Generics and Marshal / UnMarshal. What am I missing here?。

由于某种原因，在XE2中使用TJsonobject的非默认构造函数会导致问题 - 使用默认构造函数“修复”了问题。

首先，您需要将TTestobject移动到自己的单元中 - 否则，在尝试取消标记时，RTTI将无法找到/创建您的对象。

    unit uTestObject;

    interface

    uses
      SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections, DbxJson, DbxJsonReflect;

    type
      {$RTTI EXPLICIT METHODS([]) PROPERTIES([vcPublished]) FIELDS([vcPrivate])}
      TTestObject=class(TObject)
      private
        aList:TStringList;
      public
        constructor Create; overload;
        constructor Create(list: array of string); overload;
        constructor Create(list:TStringList); overload;
        destructor Destroy; override;
        function Marshal:TJSonObject;
        class function Unmarshal(value: TJSONObject): TTestObject;
      published
        property List: TStringList read aList write aList;
      end;

    implementation

    { TTestObject }

    constructor TTestObject.Create;

    begin
      inherited Create;
      aList:=TStringList.Create;
    end;

    constructor TTestObject.Create(list: array of string);

    var
      I:Integer;

    begin
      Create;
      for I:=low(list) to high(list) do
        begin
          aList.Add(list[I]);
        end;
    end;

    constructor TTestObject.Create(list:TStringList);

    begin
      Create;
      aList.Assign(list);
    end;

    destructor TTestObject.Destroy;

    begin
      aList.Free;
      inherited;
    end;

    function TTestObject.Marshal:TJSonObject;

    var
      Mar:TJSONMarshal;

    begin
      Mar:=TJSONMarshal.Create();
      try
        Mar.RegisterConverter(TStringList,
          function(Data:TObject):TListOfStrings

          var
            I, Count:Integer;
          begin
            Count:=TStringList(Data).Count;
            SetLength(Result, Count);
            for I:=0 to Count-1 do
              Result[I]:=TStringList(Data)[I];
          end);
        Result:=Mar.Marshal(Self) as TJSonObject;
      finally
        Mar.Free;
      end;
    end;

    class function TTestObject.Unmarshal(value: TJSONObject): TTestObject;

    var
      Mar: TJSONUnMarshal;
      L: TStringList;

    begin
      Mar := TJSONUnMarshal.Create();
      try
        Mar.RegisterReverter(TStringList,
          function(Data: TListOfStrings): TObject

          var
            I, Count: Integer;
          begin
            Count := Length(Data);
            Result:=TStringList.Create;
            for I := 0 to Count - 1 do
              TStringList(Result).Add(string(Data[I]));
          end
        );
        //UnMarshal will attempt to create a TTestObject from the TJSONObject data
        //using RTTI lookup - for that to function, the type MUST be defined in a unit
        Result:=Mar.UnMarshal(Value) as TTestObject;
      finally
        Mar.Free;
      end;
    end;

    end.

请注意，构造函数已被重载 - 这允许您在创建对象时不需要预先填充数据即可查看代码是否可用。

以下是通用类列表对象的实现。

    unit uTestObjectList;

    interface

    uses
      SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections,
      DbxJson, DbxJsonReflect, uTestObject;

    type
      {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
      TTestObjectList<T:TTestObject,constructor> = class(TObjectList<T>)
      public
        function Marshal: TJSonObject;
        constructor Create;
        class function Unmarshal(value: TJSONObject): TTestObjectList<T>; static;
      end;

    //Note: this MUST be present and initialized/finalized so that
    //delphi will keep the RTTI information for the generic class available
    //also, it MUST be "project global" - not "module global"
    var
      X:TTestObjectList<TTestObject>;

    implementation

    { TTestObjectList<T> }
    constructor TTestObjectList<T>.Create;
    begin
      inherited Create;
      //removed the add for test data - it corrupts unmarshaling because the data is already present at creation
    end;

    function TTestObjectList<T>.Marshal: TJSonObject;
    var
      Marshal: TJsonMarshal;
    begin
      Marshal := TJSONMarshal.Create;
      try
        Marshal.RegisterConverter(TTestObjectList<T>,
          function(Data: TObject): TListOfObjects
          var
            I: integer;

          begin
            SetLength(Result,TTestObjectlist<T>(Data).Count);
            for I:=0 to TTestObjectlist<T>(Data).Count-1 do
              Result[I]:=TTestObjectlist<T>(Data)[I];
          end
        );
        Result := Marshal.Marshal(Self) as TJSONObject;
      finally
        Marshal.Free;
      end;
    end;

    class function TTestObjectList<T>.Unmarshal(value: TJSONObject): TTestObjectList<T>;

    var
      Mar: TJSONUnMarshal;
      L: TStringList;

    begin
      Mar := TJSONUnMarshal.Create();
      try
        Mar.RegisterReverter(TTestObjectList<T>,
          function(Data: TListOfObjects): TObject
          var
            I, Count: Integer;
          begin
            Count := Length(Data);
            Result:=TTestObjectList<T>.Create;
            for I := 0 to Count - 1 do
              TTestObjectList<T>(Result).Unmarshal(TJSONObject(Data[I]));
          end
        );
        //UnMarshal will attempt to create a TTestObjectList<TTestObject> from the TJSONObject data
        //using RTTI lookup - for that to function, the type MUST be defined in a unit,
        //and, because it is generic, there must be a GLOBAL VARIABLE instantiated
        //so that Delphi keeps the RTTI information avaialble
        Result:=Mar.UnMarshal(Value) as TTestObjectList<T>;
      finally
        Mar.Free;
      end;
    end;


    initialization
      //force delphi RTTI into maintaining the Generic class information in memory
      x:=TTestObjectList<TTestObject>.Create;

    finalization
      X.Free;

    end.

有几个需要注意的事情： 如果在运行时创建了一个泛型类，除非在内存中存在对该类的全局可访问对象引用，否则不会保留RTTI信息。参见这里：Delphi: RTTI and TObjectList<TObject>

因此，上述单元创建这样一个变量，并按照链接文章中所述保留它的实例。

已更新主过程，显示了对两个对象的数据进行编组和取消编组的情况：

    procedure Main;
    var
      aTestobj,
      bTestObj,
      cTestObj : TTestObject;
      aList,
      bList : TTestObjectList<TTestObject>;
      aJsonObject,
      bJsonObject,
      cJsonObject : TJsonObject;

      s: string;

    begin
      aTestObj := TTestObject.Create(['one','two','three','four']);
      aJsonObject := aTestObj.Marshal;
      s:=aJsonObject.ToString;
      Writeln(s);

      bJsonObject:=TJsonObject.Create;
      bJsonObject.Parse(BytesOf(s),0,length(s));

      bTestObj:=TTestObject.Unmarshal(bJsonObject) as TTestObject;
      writeln(bTestObj.List.Text);

      writeln('TTestObject marshaling complete.');
      readln;

      aList := TTestObjectList<TTestObject>.Create;
      aList.Add(TTestObject.Create(['one','two']));
      aList.Add(TTestObject.Create(['three']));
      aJsonObject := aList.Marshal;
      s:=aJsonObject.ToString;
      Writeln(s);

      cJSonObject:=TJsonObject.Create;
      cJSonObject.Parse(BytesOf(s),0,length(s));
      bList:=TTestObjectList<TTestObject>.Unmarshal(cJSonObject) as TTestObjectList<TTestObject>;
      for cTestObj in bList do
        begin
          writeln(cTestObj.List.Text);
        end;

      writeln('TTestObjectList<TTestObject> marshaling complete.');
      Readln;
    end;

- SilverKnight

---

我也不确定 - 从我读过的一切来看，似乎你必须关闭额外的RTTI - 然而，在我开发上面的代码时，TJSONObject正在搜索RTTI并且未能找到该对象 - 这可能与它当时不在一个单元中有关（它仍然在.dpr文件中）。我不记得在将其移动到新单元后是否尝试过没有M +指令。 - SilverKnight

我现在对它进行了更仔细的查看。首先，如果源代码被移动到一个单元中，那么M+指令是不需要的。其次，Unmarshal可以工作-但如果将其用作函数，则需要将其声明为类函数。否则，创建一个仅用于实例化另一个TTestObject的TTestObject将没有意义。 我不得不更改您建议的还原程序，以便能够声明UnMarshal为类函数。function(Data: TListOfStrings): TObject var StrList: TStringList; Str: string; begin StrList := TStringList.Create; for Str in Data do StrList.Add(Str); Result := StrList; - Bimmer_R

其实，我最初是将它写成了一个类函数，但后来我决定你不想从未编组的代码中创建对象，而是想要将数据“反序列化”到已经创建的对象中，因此发布了这个实现。在进一步研究这个主题时，我注意到TJSonObject确实会创建TTestObject类的实例，因此使用类方法可能会更少占用内存（您不需要创建2个对象来获取数据）。这是我第一次接触JSON，它非常有教育意义。 - SilverKnight

不错 :-) 但问题仍然存在。TTestObjecList的UnMarshal过程仍然缺失。我自己实际上有一个建议即将推出。但在证明自己正确之前，我不会发布任何代码。 - Bimmer_R

您最初的问题没有指定需要两个对象的示例，但是根据您在上面的评论中指出，原始答案不够充分 - 因此我已经更新了它，以包括两个对象的完整实现。我还将反序列化转换为类函数。在我看来，数据仍然很重，而且我怀疑使用RTTI的性能并不好，但是代码似乎确实产生了所需的结果。 - SilverKnight

Answer 2

这是我的解决方案。

由于我非常喜欢多态性，我实际上也希望有一个可以构建到对象层次结构中的解决方案。假设TTestObject和TTestObjectList是我们的基础对象。然后从这个基础对象派生出TMyObject和TMyObjectList。此外，我还对Object和List进行了更改-添加了Marshaller / UnMarshaller属性。

TMyObject = class(TTestObject) and TMyObjectList<T:TMyObject> = class(TTestObjectList)

现在我们引入了一些新问题。例如，如何处理层次结构中不同类型之间的编组以及如何将TJsonMarshal和TJsonUnMarshal作为TTestObject和List上的属性进行处理。

可以通过在TTestObject级别引入两种新方法来克服这个问题。称为RegisterConverters和RegisterReverters的两个类函数。然后，我们改变TTestObjectList的marshal函数，使其更简单。

为对象和列表引入了两个类函数和属性。

class procedure RegisterConverters(aClass: TClass; aMar: TJSONMarshal); virtual;
class procedure RegisterReverters(aClass: TClass; aUnMar: TJSONUnMarshal); virtual;

property Mar: TJSONMarshal read FMar write SetMar;
property UnMar: TJSONUnMarshal read FUnMar write SetUnMar;

List的Marshal函数现在可以这样完成：

function TObjectList<T>.Marshal: TJSONObject;
begin
  if FMar = nil then
    FMar := TJSONMarshal.Create(); // thx. to SilverKnight
  try
    RegisterConverters; // Virtual class method !!!!
    try
      Result := FMar.Marshal(Self) as TJSONObject;
    except
      on e: Exception do
        raise Exception.Create('Marshal Error : ' + e.Message);
    end;
  finally
    ClearMarshal; // FreeAndNil FMar and FUnMar if assigned.
  end;
end;

当然，我们仍然可以为TTestObject创建一个marshaller，但是TTestObjectList的Marshal函数将不会使用它。这样，当调用TTestObjectList（或其子类）的Marshal函数时，只会创建一个Marshaller。这样一来，我们在反向操作——UnMarshalling时，只会得到我们需要重新创建结构所需的信息：-)

现在，这个方法确实可行，但我想知道是否有人对此有任何评论？

让我们为TMyTestObject添加一个属性“TimeOfCreation”： property TimeOfCreation : TDateTime read FTimeOfCreation write FTimeOfCreation;

并在构造函数中设置该属性。

FTimeofCreation := now;

然后我们需要一个转换器，所以我们重写了TTestObject的虚拟RegisterConverters方法。

class procedure TMyTestObject.RegisterConverters(aClass: TClass; aMar: TJSONMarshal);
begin
  inherited;  // instanciate marshaller and register TTestObject converters
  aMar.RegisterConverter(aClass, 'FTimeOfCreation',
    function(Data: TObject; Field: String): string
    var
      ctx: TRttiContext;
      date: TDateTime;
    begin
      date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>;
      Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', date);
    end);
end;

我最终使用了非常简单的源代码，例如使用TTestObject。

aList := TMyTestObjectList<TMyTestObject>.Create;
      aList.Add(TMyTestObject.Create(['one','two']));
      aList.Add(TMyTestObject.Create(['three']));
      s := (aList.Marshal).ToString;
      Writeln(s);

现在我已经成功地使用多态进行了编组 :-)

顺便说一下，这也适用于非编组。我正在重建我的FireBird ORM，以便为所有对象生成此类源代码。

当前的旧版本可以在此处找到： http://code.google.com/p/objectgenerator/ 请记住，它只适用于FireBird :-)

- Bimmer_R