Delphi RTTI的使用例子

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




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;

...全文
1968 58 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
58 条回复
切换为时间正序
请发表友善的回复…
发表回复
ZyxIp 2009-09-02
  • 打赏
  • 举报
 回复
先结了.
Harryfin 2009-09-01
  • 打赏
  • 举报
 回复
连楼上都出来了...
猛禽 2009-09-01
  • 打赏
  • 举报
 回复
我05年也研究过类似的东东，不过后来用了python就懒得再整这个了。动态语言更方便。C#算个鸟屎。哈哈哈。
bob0411 2009-09-01
  • 打赏
  • 举报
 回复
不给几分不会料
ZyxIp 2009-09-01
  • 打赏
  • 举报
 回复
肯定会有这种问题,这样做解决的就是对象和表的映射,因为一般的系统中很大部分都是这样的业务,主要是为了减少代码量和出错的概率，而且这样的效率也不是最高的。

现实的业务也不是和表结构一一映射的。对于一个系统来说，根据不同的业务使用不同的技术手段来
提高开发速度和提高稳定性和一至性。

在做一个收费的程序，绝大多数的业务都是简单业务，用这种方式还不错，C/S结构，用户也就20来个，速度也不成问题。
haitao 2009-09-01
  • 打赏
  • 举报
 回复
我觉得query.fieldbyname('fname').asstring与对象的用法obj[i].fname好像没什么差别
而且，对象里的很多属性也只是运行时临时使用的，并不希望保存的
数据库记录里的一些字段也是不希望给对象直接使用的

RTTI只是给 运行时按字符串的属性名找属性 提供实现手段。
如果用数据库记录或xml、ini来保存一个对象的主要属性，也是可以 运行时按字符串的属性名找属性 的。
swei0319 2009-09-01
  • 打赏
  • 举报
 回复
UP
ZyxIp 2009-09-01
  • 打赏
  • 举报
 回复
python？ 学习一下。

54楼，你的代码和文章我收集了不少，今天终算是遇到原版真人了...

yc_8301 2009-08-31
  • 打赏
  • 举报
 回复
路过。。来学习的！
yct0605 2009-08-31
  • 打赏
  • 举报
 回复
学习
ZyxIp 2009-08-31
  • 打赏
  • 举报
 回复
一个新的系统中 数据库交互部分用 RTTI 的技术实现，大大减少了这一部分的代码量。
简单的针对表的增，删，改功能，代码量有90%的减少。只要给定表名和表中一行数据所对应的类名就可以完成。

定义了基类
TRowObjectClass=class of TRowObject;
TRowObject=class
GUID:String; //
ItemID:Integer;//唯一递增标识
end;

TRowObjectList=class //保存TRowObject数据集
private
FList:TList;

end;

TNodeObjectList=class(TRowObjectList)//保存TNodeObject数据集

end;

TNodeObject=class(TRowObject)
PGUID:String;//上级节点的标识
FChildList:TNodeObjectList;
end;

表中都有 ItemID,GUID ,PGUID(树表中) 这几个字段

TXDB.GetRowList(AClass:TRowObjectClass,ATableName:String)
begin
//返回表中的所有数据
end;

软件完成后在整理一下，搞个可用的例子出来。大家给点意见，怎么能做的更好。


pm562012803 2009-08-31
  • 打赏
  • 举报
 回复
不知道
liangpei2008 2009-08-31
  • 打赏
  • 举报
 回复
呵呵，不错！做完了借鉴借鉴~
ZyxIp 2009-08-31
  • 打赏
  • 举报
 回复
根据 obj.ItemID>0 则是添加 obj.ItemID=0 则是修改。
----------------------
写错了。应该是
-------------------
根据 obj.ItemID>0 则是修改 obj.ItemID=0 则是添加。
ZyxIp 2009-08-31
  • 打赏
  • 举报
 回复
主要是解决了表字段和类属性定义是一一对应的情况，
保存主要两种方式

class function TXDB.SaveObject(ADOQ:TADOQuery;ATableName:String;obj:TRowObject):Boolean;

根据 obj.ItemID>0 则是添加 obj.ItemID=0 则是修改。
用SQLServer 数据库则在Inster 后直接返回新增加行的 ItemID
用Access 数据库则在Insert后用GUID 反查出 ItemID

修改的时候用 Where ItemID=obj.ItemID 条件，保存除去 GUID 外的其它属性



如用户列表对象

TUserList=class

  function SaveUser(obj:TUserInfo):Boolean; 

end;



function TUserList.SaveUser(obj:TUserInfo):Boolean; 

begin

  Result:=TXDB.SaveObject(GetADOQ,'UserList',obj);

end;


界面上数据集显示到 TVirtualStringTree 中，直接在 格式中修改时调用
function SaveObjectCell(obj:TRowObject;const Att,Value:String):Boolean;
来完成对一个属性的修改。

一下步想参考 Hibermate 的方式，实现 One-To-One ,one-to-many,one-to-many 这些模式的数据的显示。
能达到不用为每个类写实现SQL就可以完成持久化保存，读取，删除的工作。

其它人也有实现的，但学习别的代码的时候不如自己去实现一下用起来更顺手一些。

fldx 2009-08-31
  • 打赏
  • 举报
 回复
每天回帖即可获得10分可用分！
diecode 2009-08-31
  • 打赏
  • 举报
 回复
学习
liangpei2008 2009-08-31
  • 打赏
  • 举报
 回复
对对象集进行修改后，LZ是如何将其存入数据库的？
fldx 2009-08-30
  • 打赏
  • 举报
 回复
每天回帖即可获得10分可用分！
yct0605 2009-08-30
  • 打赏
  • 举报
 回复
进来看看了，写的不错！
加载更多回复（36）
RTTI.zip_DELPHI RTTI_delphi_rtti
通过“RTTI.zip”中的示例，你可以更深入地理解Delphi的RTTI机制，并在实际项目中灵活应用这些概念和技术。这个压缩包提供了一个很好的学习平台，帮助开发者掌握如何在Delphi中有效地利用RTTI。
Delphi的RTTI机制文档
**Delphi的RTTI机制详解** RTTI，全称Runtime Type Information（运行时类型信息），是编程语言中的一种特性，允许程序在运行时获取对象的类型信息。在Delphi中，RTTI是一个强大的工具，它使得开发者能够在运行时...
RTTI.rar_DELPHI RTTI
这个示例源码应该包含了如何使用RTTI进行属性、方法和字段访问的实例，通过阅读和分析源码，你将更深入地理解Delphi的RTTI机制。 总的来说，掌握Delphi的RTTI不仅可以提高编程效率，还能增强对程序结构的理解，使得...
rtti-inspector-combo.zip_DELPHI RTTI_RTTIInspector_inspector
在Delphi编程环境中，RTTI（Run-Time Type Information）是一种强大的特性，允许程序在运行时获取类型信息。...通过学习和使用这个示例，开发者可以提升他们的Delphi编程技能，尤其是对运行时类型信息的运用。
巧用Delphi 2010 RTTI 管理常量(const)！
本文将详细介绍如何利用 Delphi 2010 的 RTTI 特性来高效地管理和使用常量。 #### RTTI 基础概念 RTTI 提供了一种机制来获取对象或类型的元数据（如类名、字段名、方法等），这些信息在编译时就已经确定，并且可以...
Delphi

5,928

社区成员

262,931

社区内容

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章