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类封装了接口函数类型的变化,保证网络传输与服务端自动调用处理的一致性.