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;

...全文
1901 58 打赏 收藏 转发到动态 举报
写回复
用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
delphi RTTI功能示例 演示如何在delphi 中使用rtti
RTTI.rar_DELPHI RTTI
这是个示例源码，学习自已查找RTII信息，供初学者参考。
Delphi7 向XML中添加RTTI信息.rar
Delphi7.0 向XML中添加RTTI信息，这个例子挺简单，希望大家喜欢，面向Delphi新手的，高手请绕道哦，下面是本例Delphi向XML中添加RTTI信息的关键性代码： 　　procedure TForm1.ComponentToDOM(iNode: IXmlNode; Comp: TPersistent); 　　var 　　 nProps, i: Integer; 　　 PropList: PPropList; 　　 Value: Variant; 　　 newNode: IXmlNode; 　　begin 　　 nProps := GetTypeData (Comp.ClassInfo)^.PropCount; 　　 GetMem (PropList, nProps * SizeOf(Pointer)); 　　 try 　　 GetPropInfos (Comp.ClassInfo, PropList); 　　 for i := 0 to nProps - 1 do 　　 begin 　　 Value := GetPropValue (Comp, PropList [i].Name); 　　 NewNode := iNode.AddChild(PropList [i].Name); 　　 NewNode.Text := Value; 　　 if (PropList [i].PropType^.Kind = tkClass) and (Value 0) then 　　 if TObject (Integer(Value)) is TComponent then 　　 NewNode.Text := TComponent (Integer(Value)).Name 　　 else 　　 ComponentToDOM (newNode, TObject (Integer(Value)) as TPersistent); 　　 end; 　　 finally 　　 FreeMem (PropList); 　　 end; 　　end;
一个Delphi编程使用的属性编辑器控件及实例.rar
一个Delphi编程使用的属性编辑器控件及应用实例，这个控件相信搞Delphi编程的都熟悉吧，用来生成属性设置窗口，在开发一些专用软件的时候，生成属性编辑窗口及相关参数设置窗口，给大家一个学习RTTI例子的参考而已。
Delphi技术手册
Inprise／Borland公司的Delphi可能是当前最好的Windows快速应用程序开发工具。 随着它在Linux平台上的版本Kylix的发布，它在Unix世界的前景也十分看好。Delphi完 全支持COM、ActiveX、可视化组件库（VCL），并提供了可扩展、可定制的快速应用程 序开发环境。本书是这种功能强大的开发工具的全面参考。 本书从简介Delphi Pascal并讨论Delphi对象模型开始，讨论了运行时类型信息 （RTTI）——Delphi开发环境的关键部分，这一点在Delphi的其他正式帮助文档中很 少论及。本书还用一章的篇幅讨论了Delphi中的并发编程，以及多线程应用程序的创建。 本书的主要内容是Delphi语言以字母顺序排列的完整参考。每项参考的内容都包括： 语法，使用标准编码惯例 说明参数列表，如果函数或过程包括参数的话提示和技巧—— 在实际程序中使用某个组件的实用信息一个简单的例子其他相关关键字的交叉参考本书 秉承“坚果”（In a Nutshell系列技术手册的一贯风格。不管你对Delphi的掌握程度如何， 本书都是你日常工作中不可或缺的标准参考指南。阅读本书，你将领略到Delphi的精华所在， 还可以解决实际编程中可能遇到的问题。 第一章 Delphi Pascal 单元 程序 库 包 数据类型 变量和常量 异常处理 文件1／O 函数和过程 第二章 Delphi对象模型 类和对象 接口 引用计算 消息 内存管理 旧式的对象类型 第三章 运行时类型信息 虚方法表 公布的声明 .TypInfo单元 虚方法和动态方法 初始化和结束化 自动的方法 接口 探究RTTI 第四章 并发编程 线程和进程 TThread类 BeginThread和EndThread函数 线程局部存储 进程 未来化 第五章 语言参考 第六章 系统常量 Variant类型码 开放数组类型 虚方法表偏移值 运行时错误代码 第七章 运算符 一元运算符 多元运算符 附加运算符 比较运算符 第八章 编译器指示字 附录一 命令行工具 附录二 SysUtils单元 词汇表 多谢支持【Think you to your download~】
Delphi

5,386

社区成员

262,729

社区内容

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

加载中

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

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

+ 用AI写文章