【问题标题】:Generics and Marshal / UnMarshal. What am I missing here? PART #2 :-)泛型和元帅/UnMarshal。我在这里想念什么?第2部分 :-)
【发布时间】:2011-12-02 00:15:17
【问题描述】:

跟进我之前的问题: Generics and Marshal / UnMarshal. What am I missing here?

在“第 1 部分”(上面的链接)中,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 方法。 如果有人可以制作一个并将其张贴在这里,我会喜欢的:-)

我希望你仍然对这个主题感兴趣。

亲切的问候 比亚恩

【问题讨论】:

  • 我建议您让您的问题更加集中,不那么开放,您的问题究竟是什么?
  • 首先我为我之前遇到的另一个问题提供了一个解决方案。 [链接]stackoverflow.com/questions/7528829/… 其次,如果有 UnMarshal 方法的简单解决方案,我想听听所有感兴趣的人。
  • 不要告诉我 :-),编辑问题,使其更加集中。现在到处都是......
  • 我希望这个问题现在更清楚了:-)

标签: delphi generics marshalling delphi-xe delphi-xe2


【解决方案1】:

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

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

首先,您需要将您的 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;

【讨论】:

  • 这看起来很有希望:-) ...我必须在一两天内回复您。但是 +1 承诺 :-) 顺便说一句:我的理解是 {$M+} 在 XE 及更高版本中不是必需的.....也许我也应该调查那个。
  • 我也不确定——从我读过的所有内容来看,“似乎”你必须关闭额外的 RTTI——但是,当我开发上面的代码时,TJSONObject 正在搜索 RTTI并且未能找到该对象 - 它可能与当时它不在一个单元中的事实有关(它仍在 .dpr 文件中)我不记得我是否在没有 M+ 指令的情况下尝试过它将其移至新单元。
  • 我现在仔细研究了它。首先,如果源被移动到一个单元,则不需要 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;
  • LOL:实际上,这就是我最初编写它的方式(作为类函数),但是,我后来决定你不想从解组代码创建对象,而是,想要将数据“反序列化”成一个已经创建的对象,因此,发布的实现。在对该主题的进一步调查中,我注意到 TJSonObject 确实创建了 TTestObject 类的实例,因此使用类方法可能会减少内存密集型(您不需要创建 2 个对象来获取数据)。这是我第一次接触 JSON,它很有教育意义。
  • 您的原始问题没有指定两个对象都需要一个示例,但正如您在上面的评论中指出的那样,原始答案是不够的 - 所以我已经更新它以包含两个对象的完整实现.我还继续将解组(返回)转换为类函数。在我看来,数据看起来仍然很繁重,我怀疑使用 RTTI 的性能是否很好,但代码似乎确实产生了预期的结果。
【解决方案2】:

这是我自己的解决方案。

由于我非常喜欢多态,我其实也想要一个可以构建到对象层次结构中的解决方案。假设 TTestObject 和 TTestObjectList 是我们的 BASE 对象。从那我们下降到 TMyObject 和 TMyObjectList。此外,我还对 Object 和 List 进行了更改 - 为 Marshaller/UnMarshaller 添加了属性

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

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

这可以通过在 TTestObject 级别引入两个新方法来克服。两个类函数称为 RegisterConverters 和 RegisterReverters。然后我们将 TTestObjectList 的编组函数更改为更简单的编组。

对象和列表的两个类函数和属性。

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 :-)

现在这确实有效 - 但我想知道是否有人对此有任何 cmets ?

让我们添加一个属性“TimeOfCreation”到 TMyTestObject: 属性 TimeOfCreation : TDateTime 读取 FTimeOfCreation 写入 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);

现在我已经成功地用多态性编组:-)

这也适用于 UnMarshalling btw。而且我正在重建我的 FireBird ORM 来为我的所有对象生成源代码。

当前的旧版本可以在这里找到: http://code.google.com/p/objectgenerator/ 请记住,它仅适用于 FireBird :-)

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2010-11-22
    • 2017-06-10
    • 2015-06-21
    • 2023-03-31
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多