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.