{ 前期准备一下: 对像单元, 定义了一个玩具基类 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.
DataSnap Server 中使用多态
最新推荐文章于 2023-04-20 22:41:23 发布