RO代码跟踪 之 应用RTTI
一直在找RTTI的相关材料，感觉到了D2010后RTTI的封装才够人性化。而以前的版本看RTTI源码后也感觉遮遮掩掩的，不够明朗。
读RO源码的时候发现RO的Message控件在读一个对象和写一个对象时，正是依靠RTTI动态的对象中获取数据成员并与流(Stream)相互转化。下面分析一下，以备平时使用。闲话少说，直接上码。虽然都喜欢有图无码的，但是精力有限，做些注释看懂就好。
注:D2010前版本RTTI只能获取到published属性和事件.而到了D2010后就可以获取到private方法（无私有数据成员）了.还是获取不全,有待易博龙改进.
procedure TROSerializer.ReadObject(obj: TObject);
var
props : PPropList;
cnt, i : integer;
propInf: PPropInfo;
// Temporary variables
node : IXMLNode;
int64val : int64;
intval : integer;
enuval : byte;
dblval : double;
currval : Currency;
extval : Extended;
singleval : Single;
compval : Comp; //8字节浮点型
varval : variant;
datetimeval : TDateTime;
//extval : extended;
strval : string;
{$IFNDEF DELPHI5}wstrval : widestring;{$ENDIF}
objval : TObject;
lObjectStreamExtender:IROObjectStreamExtender;
lName: string;
begin
if Assigned(obj) and (obj.ClassInfo <> nil) then begin
cnt := GetTypeData(obj.ClassInfo).PropCount; //获取obj的属性数量
if (cnt>0) then begin
{$IFDEF FPC}
props := nil;
{$ENDIF}
GetMem(props, cnt*SizeOf(PPropInfo));
try //获取属性列表指针
cnt := GetPropList(PTypeInfo(obj.ClassInfo), tkProperties, props, not GetRecordStrictOrder);
for i := 0 to (cnt-1) do begin
lName :={$IFDEF UNICODE}UTF8ToString{$ENDIF}(props^[i]^.Name); //得到属性名称
with props^[i]^ do begin
case PropType^.Kind of //属性类型
{$IFDEF FPC}tkBool,{$ENDIF}
tkEnumeration : begin //枚举类型
{$IFDEF FPC}enuval := 0;{$ENDIF}
ReadEnumerated(lName, PropType{$IFNDEF FPC}^{$ENDIF}, enuval);//根据名称从流中读取枚举类型值
SetOrdProp(obj, lName, enuval); //根据属性名称设置obj的有序属性值
end;
tkInteger : begin //整形
{$IFDEF FPC}intval := 0;{$ENDIF}
ReadInteger(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF}).OrdType, intval);
SetOrdProp(obj, lName, intval); //根据属性名称设置obj的整形属性
end;
tkFloat : begin
if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDateTime)) then begin
{$IFDEF FPC}datetimeval := 0;{$ENDIF}
ReadDateTime(lName, datetimeval);//, ArrayElementId);
SetPropValue(obj, lName, datetimeval);
end
else case GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType of
ftSingle : begin
{$IFDEF FPC}singleval := 0;{$ENDIF}
ReadDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, singleval);
SetFloatProp(obj, lName, singleval);
end;
ftDouble : begin
{$IFDEF FPC}dblval := 0;{$ENDIF}
ReadDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, dblval);
SetFloatProp(obj, lName, dblval);
end;
ftExtended : begin
{$IFDEF FPC}extval := 0;{$ENDIF}
ReadDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, extval);
SetFloatProp(obj, lName, extval);
end;
ftComp : begin
{$IFDEF FPC}compval := 0;{$ENDIF}
ReadDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, compval);
SetFloatProp(obj, lName, compval);
end;
ftCurr : begin
{$IFDEF FPC}currval := 0;{$ENDIF}
ReadDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, currval);
SetFloatProp(obj, lName, currval);
end;
end;
end;
tkLString,
{$IFDEF FPC}tkAString,{$ENDIF}
tkString : begin
{$IFDEF FPC}strval := '';{$ENDIF}
if PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TGuidString) then
ReadGuid(lName, strval)
else
ReadUTF8String(lName, strval);
SetStrProp(obj, lName, strval);
end;
tkInt64 : begin
{$IFDEF FPC}int64val := 0;{$ENDIF}
ReadInt64(lName, int64val);
SetInt64Prop(obj, lName, int64val);
end;
{$IFDEF DELPHI2009UP}tkUString,{$ENDIF}
tkWString : begin
{$IFDEF DELPHI5}
//RaiseError(err_TypeNotSupported, ['tkWString']);
ReadUTF8String(lName, strval);
SetStrProp(obj, lName, strval);
{$ELSE}
{$IFDEF FPC}wstrval := '';{$ENDIF}
ReadWideString(lName, wstrval);
propInf := GetPropInfo(obj, lName);
if propInf = nil then
raise EPropertyError.CreateResFmt(@SUnknownProperty, [lName]);
SetWideStrProp(obj, propInf, wstrval);
{$ENDIF}
end;
tkVariant : begin
{$IFDEF FPC}varval := 0;{$ENDIF}
if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDecimalVariant)) then
ReadDecimal(lName, varval)
else
ReadVariant(lName, varval);
SetVariantProp(obj, lName, varval);
end;
tkClass : begin
objval := nil;
Read(lName, PropType{$IFNDEF FPC}^{$ENDIF}, objval); //读取对象 //将props^[i]^.PropType(PPTypeInfo)传递给函数
SetObjectProp(obj, lName, objval); //设置类类型的属性的值
end;
tkInterface: begin
if PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(IXmlNode) then begin
{$IFDEF FPC} node:= nil; {$ENDIF}
ReadXml(lName, node);
RO_SetIntfProp(obj, lName, node);
end else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
end;
else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
end; { case }
end; { with }
end; { for }
finally
FreeMem(props, cnt*SizeOf(PPropInfo));
end;
end; { if Count > 0 }
if Obj.GetInterface(IROObjectStreamExtender, lObjectStreamExtender) then begin
lObjectStreamExtender.Read(Self);
end
end; { if Assigned }
end;
//向流中写对象 不做注释了 和读相近
procedure TROSerializer.WriteObject(obj: TObject);
var
props : PPropList;
cnt, i : integer;
// Temporary variables
int64val : int64;
intval : integer;
enuval : byte;
dblval : double;
currval : Currency;
extval : Extended;
singleval : Single;
datetimeval : TDateTime;
compval : Comp;
strval : string;
varval : Variant;
{$IFNDEF DELPHI5}wstrval : widestring;{$ENDIF}
objval : TObject;
pdata : PTypeData;
lObjectStreamExtender:IROObjectStreamExtender;
node: IXMLNode;
lName: string;
begin
if (obj<>NIL) and (obj.ClassInfo<>NIL) then begin
pdata := GetTypeData(obj.ClassInfo);
if (pdata<>NIL) then begin
cnt := pdata .PropCount;
if (cnt>0) then begin
{$IFDEF FPC}props:= nil;{$ENDIF}
GetMem(props, cnt*SizeOf(PPropInfo));
try
cnt := GetPropList(PTypeInfo(obj.ClassInfo), tkProperties, props, not GetRecordStrictOrder);
for i := 0 to (cnt-1) do begin
lName :={$IFDEF UNICODE}UTF8ToString{$ENDIF}(props^[i]^.Name);
with props^[i]^ do
case PropType^.Kind of
{$IFDEF FPC}tkBool,{$ENDIF}
tkEnumeration : begin
enuval := GetOrdProp(obj, lName);
WriteEnumerated(lName, PropType{$IFNDEF FPC}^{$ENDIF}, enuval);
end;
tkInteger : begin
intval := GetOrdProp(obj, lName);
WriteInteger(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.OrdType, intval);
end;
tkFloat : begin
if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDateTime)) then begin
datetimeval := GetPropValue(obj, lName);
WriteDateTime(lName, datetimeval);
end
else case GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType of
ftSingle : begin
singleval := GetFloatProp(obj, lName);
WriteDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, singleval);
end;
ftDouble : begin
dblval := GetFloatProp(obj, lName);
WriteDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, dblval);
end;
ftExtended : begin
extval := GetFloatProp(obj, lName);
WriteDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, extval);
end;
ftComp : begin
{$IFDEF FPC}
{$IFDEF WIN64}
compval := GetInt64Prop(obj, lName);
WriteInt64(lName, compval);
{$ELSE}
compval := GetOrdProp(obj, lName);
WriteInteger(lName,otSLong,compval);
{$ENDIF}
{$ELSE}
compval := GetFloatProp(obj, lName);
WriteDouble(lName, GetTypeData(PropType^)^.FloatType, compval);
{$ENDIF}
end;
ftCurr : begin
currval := GetFloatProp(obj, lName);
WriteDouble(lName, GetTypeData(PropType{$IFNDEF FPC}^{$ENDIF})^.FloatType, currval);
end;
end;
end;
tkLString,
{$IFDEF FPC}tkAString,{$ENDIF}
tkString : begin
strval := GetStrProp(obj, lName);
if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TGuidString)) then
WriteGuid(lName, strval)
else
WriteUTF8String(lName, strval);
end;
tkInt64 : begin
int64val := GetInt64Prop(obj, lName);
WriteInt64(lName, int64val);
end;
{$IFDEF DELPHI2009UP}tkUString,{$ENDIF}
tkWString : begin
{$IFDEF DELPHI5}
//RaiseError(err_TypeNotSupported, ['tkWString']);
strval := GetStrProp(obj, lName);
WriteUTF8String(lName, strval);
{$ELSE}
wstrval := GetWideStrProp(obj, lName);
WriteWideString(lName, wstrval);
{$ENDIF}
end;
tkVariant : begin
varval := GetVariantProp(obj, lName);
if (PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(TDecimalVariant)) then
WriteDecimal(lName, varval)
else
WriteVariant(lName, varval);
end;
tkClass : begin
objval := GetObjectProp(obj, lName);
Write(lName, PropType{$IFNDEF FPC}^{$ENDIF}, objval); //将props^[i]^.PropType(PPTypeInfo)传递给函数
end;
tkInterface : begin
if PropType{$IFNDEF FPC}^{$ENDIF}=TypeInfo(IXmlNode) then begin
// if props^[i] = TypeInfo(IXmlNode) then begin
node := RO_GetIntfProp(obj, lName) as IXMLNode;
WriteXml(lName, node);
end else RaiseError(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
end;
else RaiseError(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(props^[i].PropType^.Kind))])
end;
end;
finally
FreeMem(props, cnt*SizeOf(PPropInfo));
end;
end;
end;
if Obj.GetInterface(IROObjectStreamExtender, lObjectStreamExtender) then begin
lObjectStreamExtender.Write(Self);
end
end;
end;
使用RTTI可以按一定的顺序遍历类中所有属性,保证写和读的顺序一致.这样才能使读写不会出现顺序错误.特殊的地方就是在读写string类型时,首先把第一个字节(保存了string的长度)写入/读出,接着在写入/读出内容部分.最复杂的地方是读写类类型的属性.在Read和Write方法中,读取/写入对象的类属性.从中可以看到,我们要序列化的对象的类类型属性中不能再含有非指定类型的类属性了.也就是说你要定义类的类类型属性中的成员,只能是RO指定的类型或普通数据类型.说着咬嘴,看看下面的tkClass部分就知道了.
procedure TROSerializer.Read(const aName: string; aTypeInfo: PTypeInfo;
var Ptr; ArrayElementId : integer = -1);
begin
case aTypeInfo^.Kind of
{$IFDEF FPC}tkBool,{$ENDIF}
tkEnumeration : ReadEnumerated(aName, aTypeInfo, byte(Ptr), ArrayElementId);
tkInteger : ReadInteger(aName, GetTypeData(aTypeInfo)^.OrdType, Ptr, ArrayElementId);
tkInt64 : ReadInt64(aName, Ptr, ArrayElementId);
tkFloat : if (aTypeInfo=TypeInfo(TDateTime))
then ReadDateTime(aName, Ptr, ArrayElementId)
else ReadDouble(aName, GetTypeData(aTypeInfo)^.FloatType, Ptr, ArrayElementId);
{$IFDEF UNICODE}tkUString,{$ENDIF}
tkWString : ReadWideString(aName, Ptr, ArrayElementId);
tkLString,
{$IFDEF FPC}tkAString,{$ENDIF}
tkString :
if aTypeInfo = TypeInfo(TGuidString) then
ReadGuid(aName, Ptr, ArrayElementId)
else if aTypeInfo = TypeInfo(UTF8String) then
ReadUTF8String(aName, Ptr, ArrayElementId)
else
ReadAnsiString(aName, Ptr, ArrayElementId);
tkClass : if isROCustomStreamable(GetTypeData(aTypeInfo).ClassType) then
ReadROCustomStreamable(aName, GetTypeData(aTypeInfo).ClassType, Ptr, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROArray) then
ReadArray(aName, GetTypeData(aTypeInfo).ClassType, Ptr, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROComplexType) then
ReadStruct(aName, GetTypeData(aTypeInfo).ClassType, Ptr, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Binary) then
ReadBinary(aName, Ptr, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Exception) then
ReadException(aName, Ptr, ArrayElementId)
else
raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
tkVariant : if aTypeInfo = TypeInfo(TDecimalVariant) then
ReadDecimal(aName, Ptr, ArrayElementId)
else
ReadVariant(aName, Ptr, ArrayElementId);
tkInterface :
begin
if aTypeInfo = TypeInfo(IXmlNode) then begin
ReadXml(aName, Ptr, ArrayElementId);
end else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
end;
else RaiseError(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
end;
end;
procedure TROSerializer.Write(const aName: string; aTypeInfo: PTypeInfo;
const Ref; ArrayElementId : integer = -1);
begin
case aTypeInfo^.Kind of
{$IFDEF FPC}tkBool,{$ENDIF}
tkEnumeration : WriteEnumerated(aName, aTypeInfo, Ref, ArrayElementId);
tkInteger : WriteInteger(aName, GetTypeData(aTypeInfo)^.OrdType, Ref, ArrayElementId);
tkFloat : if (aTypeInfo=TypeInfo(TDateTime))
then WriteDateTime(aName, Ref, ArrayElementId)
else WriteDouble(aName, GetTypeData(aTypeInfo)^.FloatType, Ref, ArrayElementId);
{$IFDEF UNICODE}tkUString,{$ENDIF}
tkWString : WriteWideString(aName, Ref, ArrayElementId);
tkLString,
{$IFDEF FPC}tkAString,{$ENDIF}
tkString : if (aTypeInfo=TypeInfo(TGuidString)) then
WriteGuid(aName, Ref, ArrayElementId)
else if aTypeInfo = TypeInfo(UTF8String) then
WriteUTF8String(aName, Ref, ArrayElementId)
else
WriteAnsiString(aName, Ref, ArrayElementId);
tkInt64 : WriteInt64(aName, Ref, ArrayElementId);
tkClass : if isROCustomStreamable(GetTypeData(aTypeInfo).ClassType) then
WriteROCustomStreamable(aName, GetTypeData(aTypeInfo).ClassType, Ref, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROArray) then
WriteArray(aName, Ref,GetTypeData(aTypeInfo).ClassType, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(TROComplexType) then
WriteStruct(aName, Ref, GetTypeData(aTypeInfo).ClassType, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Binary) then
WriteBinary(aName, Ref, ArrayElementId)
else if GetTypeData(aTypeInfo).ClassType.InheritsFrom(Exception) then
WriteException(aName, Ref, ArrayElementId)
else
raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
tkVariant : if aTypeInfo = TypeInfo(TDecimalVariant) then
WriteDecimal(aName, Ref, ArrayElementId)
else
WriteVariant(aName, Ref, ArrayElementId);
tkInterface :
begin
if aTypeInfo = TypeInfo(IXmlNode) then begin
WriteXml(aName, Ref, ArrayElementId);
end else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
end;
else raise EROUnknownType.CreateFmt(err_TypeNotSupported, [ROGetEnumName(TypeInfo(TTypeKind), Ord(aTypeInfo^.Kind))]);
end;
end;
当然RO用到RTTI的地方还有很多,如
function TROInvoker.CustomHandleMessage(const aFactory: IROClassFactory;
const aMessage: IROMessage;
const aTransport: IROTransport;
out oResponseOptions: TROResponseOptions): boolean;
var
mtd: TMessageInvokeMethod;
instance: IInterface;
begin
result := FALSE;
if FAbstract then RaiseError(err_AbstractService, [aFactory.InterfaceName]);
mtd := nil;
instance := nil;
// The message is guaranteed not to be NIL and to have a name and an InterfaceName at this point
@mtd := MethodAddress('Invoke_' + aMessage.MessageName);
if (@mtd <> nil) then try
try
aFactory.CreateInstance(aMessage.ClientID, instance);
if (instance = nil) then RaiseError(err_ClassFactoryDidNotReturnInstance, [aMessage.InterfaceName]);
BeforeInvoke(mtd, instance, aFactory, aMessage, aTransport);
mtd(instance, aMessage, aTransport, oResponseOptions);
AfterInvoke(mtd, instance, aFactory, aMessage, aTransport, nil);
result := TRUE;
except
on E: Exception do begin
AfterInvoke(mtd, instance, aFactory, aMessage, aTransport, E);
raise;
end;
end;
finally
if (instance <> nil) then aFactory.ReleaseInstance(aMessage.ClientID, instance);
end
else
RaiseError(err_UnknownMethod, [aMessage.MessageName, aFactory.InterfaceName]);
end;
这个函数根据客户端传到服务端的方法名称在加上前缀'Invoke_'来调用基类(TXXXX_Invoker)中定义的方法,而不需要在基类中
定义virtul方法.其实RO中你可以定义各种类型的函数,参数和返回值随意,但是他在服务端对每个接口都自动生成了一个Invoker类
,这个类中生成接口中所有方法的对应调用,将原接口中方法的参数和返回值都放在Stream中.这样,每个方法不管你原来啥样,在
Invoker中都长得一个模样了:
procedure TFirstSampleService_Invoker.Invoke_Nicknames(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
如此,在基类中用RTTI根据方法名查找方法地址,在调用(反正你参数都一样,有了地址再传参就可调用).可见RO通过接口模板在客户端生成TXXX_Proxy代理类,在服务端生成TXXX_Invoker类封装了接口函数类型的变化,保证网络传输与服务端自动调用处理的一致性.