Delphi RTTI的使用例子,该如何解决

2012-02-15

Delphi RTTI的使用例子最近在用C#，觉得它的反射真是不错，在也不用将数据库反回的值一行行，一个属性一个属

Delphi RTTI的使用例子
最近在用C#，觉得它的反射真是不错，在也不用将数据库反回的值一行行，一个属性一个属性的给对象进行赋值了。让代码看着少了很多。
Delphi 也有RTTI 一直没有用过，将大家的代码归纳了一下。给看看能不能更精减和合理一些。

Delphi(Pascal) code

 
  
 uses TypInfo 
  
 type 
   TXRTTI=class 
  
   public 
     //给定一个数据集合将值设置给对象 
  
     //得到一个对象的属性的数据类型 
     class function GetObjAttTypeInfo(obj:TPersistent;const AAtt:String;var ATypeInfo:TTypeInfo):Boolean; 
     //给定一个属性名和值，给对象设置 
     class function SetObjValue(obj:TPersistent;const AAtt:String;AValue:Variant;ATypeInfo:TTypeInfo):Boolean;overload; 
     class function SetObjValue(obj:TPersistent;const AAtt:String;AValue:Variant):Boolean;overload; 
     class function SetObjValueStr(obj:TPersistent;const AAtt:String;AValue:String):Boolean;overload; 
     //根据一个属性名，得到对象的值 
     class function GetObjValue(obj:TPersistent;const AAtt:String):Variant; 
     class function GetObjValueToStr(obj:TPersistent;const AAtt:String):String; 
  
   end; 
  
   TXDB=class 
     //将数据集转换为对象列表 
     class function DataSetToList(ADOQ:TADOQuery;AClass:TPersistentClass;AList:TList):Integer; 
     class function DataSetToObj(ADOQ:TADOQuery;obj:TPersistent;ARow:Integer=1):Boolean; 
   end; 
  
 implementation 
  
 { TXDB } 
  
 class function TXDB.DataSetToList(ADOQ:TADOQuery;AClass: TPersistentClass; AList: TList): Integer; 
 var 
   obj:TPersistent; 
   i,f:Integer; 
  
   PropList: PPropList; 
   ClassTypeInfo: PTypeInfo; 
   ClassTypeData: PTypeData; 
 begin 
 //先取对象属性信息 
   ClassTypeInfo := AClass.ClassInfo; 
   ClassTypeData := GetTypeData(ClassTypeInfo); 
   GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); 
   GetPropInfos(AClass.ClassInfo, PropList); 
  
   for f:=0 to ADOQ.FieldCount-1 do 
   begin 
     ADOQ.Fields[f].Tag:=-1; 
     for i := 0 to ClassTypeData.PropCount - 1 do 
       if (PropList[i]^.PropType^.Kind  <> tkMethod) then 
         if SameText(ADOQ.Fields[f].FieldName,PropList[i]^.Name) then 
         begin 
           ADOQ.Fields[f].Tag:=i; 
           Break; 
         end; 
   end; 
 //数据集合转换成对象列表 
   while Not ADOQ.Eof do 
   begin 
     obj:=AClass.Create; 
     for i:=0 to ADOQ.FieldList.Count-1 do 
     begin 
       if (ADOQ.Fields[i].Tag>=0)and(ADOQ.Fields[i].Value <>Null) then 
         TXRTTI.SetObjValue(obj,ADOQ.Fields[i].FieldName,ADOQ.Fields[i].Value,PropList[ADOQ.Fields[i].Tag]^.PropType^^); 
     end; 
     AList.Add(obj); 
     ADOQ.Next; 
   end; 
  
   FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); 
   Result:=AList.Count; 
 end; 
  
 class function TXDB.DataSetToObj(ADOQ: TADOQuery; 
   obj:TPersistent;ARow:Integer=1): Boolean; 
 var 
   i,f:Integer; 
  
   PropList: PPropList; 
   ClassTypeInfo: PTypeInfo; 
   ClassTypeData: PTypeData; 
 begin 
 //先取对象属性信息 
   ClassTypeInfo := obj.ClassInfo; 
   ClassTypeData := GetTypeData(ClassTypeInfo); 
   GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); 
   GetPropInfos(obj.ClassInfo, PropList); 
  
   for f:=0 to ADOQ.FieldCount-1 do 
   begin 
     ADOQ.Fields[f].Tag:=-1; 
     for i := 0 to ClassTypeData.PropCount - 1 do  
 
       if (PropList[i]^.PropType^.Kind  <> tkMethod) then 
         if SameText(ADOQ.Fields[f].FieldName,PropList[i]^.Name) then 
         begin 
           ADOQ.Fields[f].Tag:=i; 
           Break; 
         end; 
   end; 
 //数据集合转换成对象列表 
   ADOQ.RecNo:=ARow; 
   for i:=0 to ADOQ.FieldList.Count-1 do 
   begin 
     if (ADOQ.Fields[i].Tag>=0)and(ADOQ.Fields[i].Value <>Null) then 
       TXRTTI.SetObjValue(obj,ADOQ.Fields[i].FieldName,ADOQ.Fields[i].Value,PropList[ADOQ.Fields[i].Tag]^.PropType^^); 
   end; 
  
   FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); 
   Result:=True; 
 end; 
  
 { TXRTTI } 
  
 class function TXRTTI.GetObjAttTypeInfo(obj: TPersistent; 
   const AAtt: String;var ATypeInfo:TTypeInfo): Boolean; 
 var 
   i:Integer; 
  
   PropList: PPropList; 
   ClassTypeInfo: PTypeInfo; 
   ClassTypeData: PTypeData; 
 begin 
   Result:=False; 
   ClassTypeInfo := obj.ClassType.ClassInfo; 
   ClassTypeData := GetTypeData(ClassTypeInfo); 
   GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); 
   GetPropInfos(obj.ClassInfo, PropList); 
  
   for i := 0 to ClassTypeData.PropCount - 1 do 
     if (PropList[i]^.PropType^.Kind  <> tkMethod) then 
       if SameText(AAtt,PropList[i]^.Name) then 
       begin 
        // AAtt:=PropList[i]^.Name; 属性名不区分大小写，所以不用反正正确的属性值 
         ATypeInfo:=PropList[i]^.PropType^^; 
         Result:=True; 
         Break; 
       end; 
   FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount); 
 end; 
  
 class function TXRTTI.GetObjValue(obj: TPersistent; 
   const AAtt: String): Variant; 
 var 
   AKind:TTypeKind; 
   ATypeInfo:TTypeInfo; 
 begin 
 //给定一个属性名称和值，给对应设置 
   Result:=True; 
   GetObjAttTypeInfo(obj,AAtt,ATypeInfo); 
  
   case ATypeInfo.Kind of 
     tkInteger :Result:=GetInt64Prop(obj,AAtt); 
     tkFloat   :Result:=GetFloatProp(obj,AAtt); 
     tkInt64   :Result:=GetInt64Prop(obj,AAtt); 
     tkString  :Result:=GetStrProp(obj,AAtt); 
     tkLString :Result:=GetStrProp(obj,AAtt); 
     tkWString :Result:=GetStrProp(obj,AAtt); 
     tkVariant :Result:=GetVariantProp(obj,AAtt); 
     else 
       Result:=null; 
   end; 
 end; 
  
 class function TXRTTI.GetObjValueToStr(obj: TPersistent; 
   const AAtt: String): String; 
 var 
   AKind:TTypeKind; 
   ATypeInfo:TTypeInfo; 
 begin 
 //给定一个属性名称和值，给对应设置 
   GetObjAttTypeInfo(obj,AAtt,ATypeInfo); 
   case ATypeInfo.Kind of 
     tkInteger :Result:=IntToStr(GetInt64Prop(obj,AAtt)); 
     tkFloat   :Result:=FloatToStr(GetFloatProp(obj,AAtt)); 
     tkInt64   :Result:=IntToStr(GetInt64Prop(obj,AAtt)); 
     tkString  :Result:=GetStrProp(obj,AAtt); 
     tkLString :Result:=GetStrProp(obj,AAtt); 
     tkWString :Result:=GetStrProp(obj,AAtt); 
     tkVariant :Result:=VarToStrDef(GetVariantProp(obj,AAtt),''); 
     else 
       Result:=''; 
   end; 
 end; 
  
 class function TXRTTI.SetObjValue(obj: TPersistent; const AAtt: String; 
   AValue: Variant):Boolean;  
 
 var 
   ATypeInfo:TTypeInfo; 
 begin 
 //给定一个属性名称和值，给对应设置 
   GetObjAttTypeInfo(obj,AAtt,ATypeInfo); 
   Result:=SetObjValue(obj,AAtt,AValue,ATypeInfo); 
 end; 
  
 class function TXRTTI.SetObjValue(obj: TPersistent; const AAtt: String; 
   AValue: Variant; ATypeInfo: TTypeInfo): Boolean; 
 var 
   i:Integer; 
   f:Double; 
   t:Int64; 
 begin 
 //给定一个属性名称和值，给对应设置 
   Result:=True; 
   case ATypeInfo.Kind of 
     tkInteger: 
       begin 
         i:=AValue; 
         SetInt64Prop(obj,AAtt,i); 
       end; 
     tkFloat  : 
       begin 
         f:=AValue; 
         SetFloatProp(obj,AAtt,f); 
       end; 
     tkInt64: 
       begin 
         t:=AValue; 
         SetInt64Prop(obj,AAtt,t); 
       end; 
     tkString:SetStrProp(obj,AAtt,AValue); 
     tkLString:SetStrProp(obj,AAtt,AValue); 
     tkWString:SetStrProp(obj,AAtt,AValue); 
     tkVariant:SetVariantProp(obj,AAtt,AValue); 
     else 
       Result:=False; 
   end; 
  
 end; 
  
 class function TXRTTI.SetObjValueStr(obj: TPersistent; const AAtt: String; 
   AValue: String): Boolean; 
 var 
   AKind:TTypeKind; 
   i:Integer; 
   f:Double; 
   t:Int64; 
   ATypeInfo:TTypeInfo; 
 begin 
 //给定一个属性名称和值，给对应设置 
   Result:=True; 
   GetObjAttTypeInfo(obj,AAtt,ATypeInfo); 
  
   case ATypeInfo.Kind of 
     tkInteger: 
       begin 
         i:=StrToIntDef(AValue,0); 
         SetInt64Prop(obj,AAtt,i); 
       end; 
     tkFloat  : 
       begin 
         f:=StrToFloatDef(AValue,0); 
         SetFloatProp(obj,AAtt,f); 
       end; 
     tkInt64: 
       begin 
         t:=StrToInt64Def(AValue,0); 
         SetInt64Prop(obj,AAtt,t); 
       end; 
     tkString:SetStrProp(obj,AAtt,AValue); 
     tkLString:SetStrProp(obj,AAtt,AValue); 
     tkWString:SetStrProp(obj,AAtt,AValue); 
     tkVariant:SetVariantProp(obj,AAtt,AValue); 
     else 
       Result:=False; 
   end; 
  
 end;

[解决办法]
TGUID = packed record
D1: Longword;
D2: Word;
D3: Word;
D4: array[0..7] of Byte;
end;

TGUID是record,不是TObject
[解决办法]
SQL 2005的varchar(Max)也得不到相类的类型和属性
[解决办法]
http://alex.ciobanu.org/?p=55
Forcing RTTI on record types
[解决办法]
因为在d2010之前（手头没2009，测不了，但估计和以前版本一样）TGUID没有rtti，也就是说 TypeInfo(TGUID) 会得到一个编译期错误。现在记不清以前的研究结果了，印象中如果一个record中不包括任何由rtl管理生存期的类型（如string、动态数组）时，是不会生成TypeInfo的（在编译时，如果没有TypeInfo的话，自动管理中的System._Finalize将会忽略不编译）。而没有TypeInfo的属性类型，也就没法生成rtti，因为rtti属性表中第一个就是指向该属性类型的TypeInfo的。
而d2010增强了rtti，TGUID也会生成TypeInfo，所以再用它做类型的属性就可以通过rtti获取了。这也是d2010编译出来的文件大了许多的原因

------解决方案--------------------

那用TGUID 定义了属性，在RTTI中总应该有个什么信息吧？？D难道不有将它写入到RTTI中吗？或用其它什么办法可以得到？
-------------------------

不是任何类型在published下都有类型信息的。

热点排行

.NET

Delphi RTTI的使用例子,该如何解决