DataSnap Server 中使用多态

{ 前期准备一下: 对像单元,定义了一个玩具基类 TToy 和它的派生类 TKitte
  把定义对像独立到一个新单元是必要的,因为客户端也需要引用这个单元 }

unit ToyObject;

interface

uses
  Classes;

type
  { TToy }

  TToy = class(TPersistent)
  private
    FName: string;
  published
    property Name: string read FName write FName;
  end;

  { TKitte }

  TGender = (gdMale,gdFemale);

  TKitte = class(TToy)
  private
    FGender: TGender;
  published
    property Gender: TGender read FGender write FGender;
  end;

implementation

end.

{ 用向导产生一个 ServerMethod,网上大量介绍这个的费话就不多说了 }
unit Unit1;

interface

uses
  SysUtils,Classes,DSServer,{引用}ToyObject;

type
  {$METHODINFO ON}
  TServerMethods1 = class(TComponent)
  private
    { Private declarations }
  public
    { Public declarations }
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
    { 这里加入的新函数返回 TToy 基类 }
    function GetToy: TToy;
  end;
  {$METHODINFO OFF}

implementation


uses StrUtils;

function TServerMethods1.EchoString(Value: string): string;
begin
  Result := Value;
end;

function TServerMethods1.GetToy: TToy;
begin
  { 建立并返回派生类 }
  Result := TKitte.Create;
  TKitte(Result).Name := 'angry kitte';
  TKitte(Result).Gender := gdFemale;
end;

function TServerMethods1.ReverseString(Value: string): string;
begin
  Result := StrUtils.ReverseString(Value);
end;

end.

{ 客户端代码示例... }
{ 这里为了说明问题没用产生的 proxies }
procedure TForm3.Button1Click(Sender: TObject);
var
  Command: TDBXCommand;
  UnMarshal: TJSONUnMarshal;
  JSONValue: TJSONValue;
  Toy: TToy;
begin
  Command := sqlConnection1.DBXConnection.CreateCommand;
  Command.CommandType := TDBXCommandTypes.DSServerMethod;
  Command.Text := 'TServerMethods1.GetToy';
  Command.Prepare;

  Command.ExecuteUpdate;
  UnMarshal := TDBXClientCommand(Command.Parameters[0].ConnectionHandler).GetJSONUnMarshaler;
  try
    JSONValue := Command.Parameters[0].Value.GetJSONValue(True);
    Memo1.Text := JSONValue.ToString;
    { 执行到这里时出错了,提示为 Internal: Cannot instantiate type TToyObject.TKitte }
    Toy := TToy(UnMarshal.UnMarshal(JSONValue));
    Edit1.Text := Toy.Name;
  finally
    FreeAndNil(UnMarshal)
  end
end;

虽然执行出错,但看 Memo1.Text 的内容为:
{"type":"ToyObject.TKitte","id":1,"fields":{"FGender":"gdFemale","FName":"angry kitte"}}
它是正确的,为什么无法实例化类型?  跟踪了一下发现,RTTI  这里并不认识 TKitte 类型,虽然引用了 ToyObject,但 TKitte 类型从未被使用到,这个被 Delphi 给优化掉了

....总之是相当无语,DataSnap Server 思想上是非常不错,可惜总是忽略了无数细节
怀念一下 WebService 中 InvRegistry,准备之后实现一个这个类似功能的小编

okkk解决一下上面问题,在 ToyObject 中加几句写到

  procedure RegisterClass(AClass: TClass);
  begin
    { 无代码 }
  end;

initialization
  RegisterClass(TToy);
  RegisterClass(TKitte);
end.
基本上就长得很像 InvRegistry.RegisterXSClass,再执行上面客户端示例就正确了
为了方便,下面再贴出完整的 ToyObject

{ 对像单元,
  定义了一个玩具基类 TToy 和它的派生类 TKitte
  把定义对像独立到一个新单元是必要的,因为客户端也需要引用这个单元 }

unit ToyObject;

interface

uses
  Classes;

type
  { TToy }

  TToy = class(TPersistent)
  private
    FName: string;
  published
    property Name: string read FName write FName;
  end;

  { TKitte }

  TGender = (gdMale,gdFemale);

  TKitte = class(TToy)
  private
    FGender: TGender;
  published
    property Gender: TGender read FGender write FGender;
  end;


implementation

  procedure RegisterClass(AClass: TClass);
  begin
    { 无代码 }
  end;

initialization
  RegisterClass(TToy);
  RegisterClass(TKitte); end.