DELPHI 利用RTTL实现DAO模式下属性的动态设置及精确生成SQL语句

最新推荐文章于 2019-09-26 16:06:00 发布
最新推荐文章于 2019-09-26 16:06:00 发布
阅读量652 收藏
点赞数
分类专栏： delphi 文章标签： dao delphi sql integer function 数据库连接池 
从一个简单的例子开始。创建一个USERDAO

。



    

userDAO := TUserDAO(daofact.getDAO('TUserDAO', getpoolWapper)); 


daofact

，是DAO

工厂， 'TUserDAO',

客户可以不用知道DAO

是怎么创建的，隐藏实现细节。getpoolWapper, 

是注入的一个数据库连接。（这里可以用数据库连接池实现）具体请参考我前一篇文章《用Dunit

测试 BPL

方式实现的数据库连接池实战开发》。



    




function TDAOFactory.getDAO(const daoClassName: String; tmpIConnWrap: IConnPoolWrapper): TObject;


var


  

tmpPer: TPersistent;


begin


  

if FindClass(daoClassName) <> nil then


  

begin


    

tmpPer := TPersistentClass(FindClass(daoClassName)).Create;


    

Result := tmpPer;


 


    

Supports(tmpPer, StringToGUID('{C98D6EC3-86E8-4274-A812-FA73C6B07B4F}'), IBasDAO);


    

try


      

IBasDAO.initializeDAO(tmpIConnWrap);


    

except


      

IBasDAO := nil;


    

end;


  

end;


  




end;


    



由一BASDAO

， 取得注入的数据库连接。注：所有数据操作方面都应该是由DAO

层面的。



constructor TBasicDAO.Create(tmpIConnWrap: IConnPoolWrapper);


begin


  

inherited Create;


  

tmpPer := TDataPersistent.Create(tmpIConnWrap);


  

IDataPer := IDataPersistent(tmpPer);


  

DAOAdapter := TDAOAdapter.Create(IDataPer);


end;


  

TDataPersistent

类具体包装了数据库操作部分， 它的接口入下：



  

IDataPersistent = interface(IInterface)


    

['{16437543-63E7-41F1-914B-0E3AE8A3A5CC}']


    

procedure BeginTrans;


    

procedure CommitTrans;


    

procedure RollBackTrans;


    

function SelectDataSet(const SelectStr: String): TDataSet;


    

function InsertDataSet(const InsertStr: String): Boolean;


    

function UpdateDataSet(const UpdateStr: String): Boolean;


    

function DeleteDataSet(const DeleteStr: String): Boolean;


   

end;


 


 IBasicDAO = interface(IInterface)


    

['{C98D6EC3-86E8-4274-A812-FA73C6B07B4F}']


    

procedure initializeDAO(tmpIConnWrap: IConnPoolWrapper);


    

function selectTOList(pTO: TObject; startRow: Integer; howManyRows: Integer): TObjectList; overload;


    

function selectTOList(startRow: Integer; howManyRows: Integer): TObjectList; overload;


  

end;


 


   

IUserDAO = interface(IBasicDAO)


    

['{91FF66E5-F230-4AC8-B0AB-1E1A2E741A42}']


    

function insertDAO(pUserTO: TUserTO): Boolean;


    

function updateDAO(pUserTO: TUserTO): Boolean;


    

function deleteDAO(pUserTO: TUserTO): Boolean;


  

end;


 


    



所有DAO

的insert, update, delete 

操作都“

委托”

给了TDAOAdapter

实现。TDAOAdapter

利用rttl

技术对TO

属性存取， 自动生成了 insert ,update, delete

语句，及属性“

动态”

设置。



利用这一点，使得所有的TO

都非常方便的“

自动存取”

。



 


constructor TUserDAO.Create(tmpIConnWrap: IConnPoolWrapper);


begin


  

inherited Create(tmpIConnWrap);


end;


 


function TUserDAO.insertDAO(pUserTO: TUserTO): Boolean;


begin


  

Result := FDAOAdapter.InsertDAO(pUserTO, 'Customer');


end;


 


function TUserDAO.updateDAO(pUserTO: TUserTO): Boolean;


begin


  

Result := FDAOAdapter.updateDAO(pUserTO, 'Customer');


end;


 


function TUserDAO.deleteDAO(pUserTO: TUserTO): Boolean;


begin


  

Result := FDAOAdapter.deleteDAO(pUserTO, 'Customer');


end;


 


function TUserDAO.selectTOList(pTO: TObject; startRow: Integer; howManyRows: Integer): TObjectList;


var


  

tmpTable: String;


begin


  

tmpTable := 'Customer';


  

Result := FDAOAdapter.selectTOList(tmpTable, pTO, startRow, howManyRows);


end;


 


从上面的代码看出“

委托”

给了FDAOAdapter, FDAOAdapter

的具体实现如下：



 


function TDAOAdapter.getSearchSQLString(Const pTO: TObject; tmpTbname: String): String;


var


  

i: Integer;


  

tmpSQL, tmpFid: String;


  

tmpPropList: TMPropList;


begin


  

tmpSQL := 'select ';


  

tmpPropList := TDataTransferObject(pTO).FPropList;


 


  

for i:=1 to tmpPropList.PropCount-1 do


  

begin


    

tmpSQL :=  

tmpSQL + GetFldName(tmpPropList.PropNames[i]) +','


  

end;


  

tmpSQL := Copy(tmpSQL,0, length(tmpSQL)-1);


  

tmpSQL := tmpSQL +' FROM '+tmpTbname+' where 1=1';


 


  

for i:=1 to tmpPropList.PropCount-1 do


  

begin


    

case tmpPropList.Props[i]^.PropType^.Kind of


      

tkInteger:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+IntToStr( GetOrdProp(pTO, tmpPropList.Props[i]) );


      

tkInt64:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+IntToStr( GetInt64Prop(pTO, tmpPropList.Props[i]) );


      

tkChar, tkLString, tkString:


        

if not (Trim( GetStrProp(pTO, tmpPropList.Props[i]) ) = '') then


          

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetStrProp(pTO, tmpPropList.Props[i]) );


      

tkSet:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetSetProp(pTO, tmpPropList.Props[i]) );


      

tkEnumeration:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetEnumProp(pTO, tmpPropList.Props[i]) );


      

tkFloat:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+FloatToStr( GetFloatProp(pTO, tmpPropList.Props[i]) );


      

tkWChar, tkWString:


        

if not (Trim(GetWideStrProp(pTO, tmpPropList.Props[i])) = '') then


          

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetWideStrProp(pTO, tmpPropList.Props[i]) );


    

end;


 


  

end;


  

Result := tmpSQL;


 


end;


 


 


 


 


function TDAOAdapter.getDeleteSQLString(Const pTO: TObject; tmpTbname: String): String;


var


  

i: Integer;


  

tmpSQL: String;


  

tmpPropList: TMPropList;


begin


  

tmpSQL := 'Delete '+tmpTbname+' where 1=1 ';


  

tmpPropList := TDataTransferObject(pTO).FPropList;


 


  

for i:=1 to tmpPropList.PropCount-1 do


  

begin


    

case tmpPropList.Props[i]^.PropType^.Kind of


      

tkInteger:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+IntToStr( GetOrdProp(pTO, tmpPropList.Props[i]) );


      

tkInt64:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+IntToStr( GetInt64Prop(pTO, tmpPropList.Props[i]) );


      

tkChar, tkLString, tkString:


        

if not (Trim( GetStrProp(pTO, tmpPropList.Props[i]) ) = '') then


          

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetStrProp(pTO, tmpPropList.Props[i]) );


      

tkSet:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetSetProp(pTO, tmpPropList.Props[i]) );


      

tkEnumeration:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetEnumProp(pTO, tmpPropList.Props[i]) );


      

tkFloat:


        

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+FloatToStr( GetFloatProp(pTO, tmpPropList.Props[i]) );


      

tkWChar, tkWString:


        

if not (Trim(GetWideStrProp(pTO, tmpPropList.Props[i])) = '') then


          

tmpSQL := tmpSQL +' and '+ GetFldName(tmpPropList.PropNames[i])+'='+QuotedStr( GetWideStrProp(pTO, tmpPropList.Props[i]) );


    

end;


 


  

end;


 


  

Result := tmpSQL;


end;


 


  



客户端的数据由TDAOAdapter

返回.




function TDAOAdapter.executeSeach(Const pTO: TObject; searchStr: String; startRow: Integer; howManyRows: Integer): TObjectList;


begin


  

if not assigned(rowSetList) then


    

rowSetList := TRowSetWrapperList.Create;


 


  

Result := rowSetList.CreateDTOObject(pTO.ClassName, DataPer.SelectDataSet(searchStr));


end;


 


TRowSetWrapperList 

实现了tdataset(

动态生成clientdateset)

的导航.




getindex; next ,last

等方法。



 


 


客户端的代码如下：



  

tmpList: TObjectList;


  

userTO := TUserTo.Create;


 


  

//

查找所有yhh

为'01'

的TO

返回TObjectList;




  

userTo.yhh := '01';


  

tmpList := iInter.selectTOList(userTO, 0, 1000);


 


  

for i:=0 to tmpList.Count-1 do


  

begin


    

tmpTO := TUserTo(tmpList.Items[i]);


    

ShowMESSAGE(TMPtO.yhm);


  

end;


 


 


新增如下：



 


 


function TDAOAdapter.getSearchSQLString(Const pTO: TDataTransferObject): String;


var


  

i,j: Integer;


  

tmpSQL, tmpFid, tmpTbname: String;


  

tmpPropList, tmpProp2: TMPropList;


  

tmpObj: TObject;


  

tmpInfo: TTypeInfo;


begin


  

tmpSQL := 'select ';


 


  

if not pTO.isDetail then


  

begin


    

//

单表情况:




    

tmpPropList := pTO.FPropList;


    

tmpTbname := pTO.tbName;


 


    

for i:=0 to tmpPropList.PropCount-1 do


    

begin


      

if GetFldName(tmpPropList.PropNames[i])<>'' then


        

tmpSQL :=  

tmpSQL + GetFldName(tmpPropList.PropNames[i]) +','


    

end;


    

tmpSQL := Copy(tmpSQL,0, length(tmpSQL)-1);


    

tmpSQL := tmpSQL +' FROM '+tmpTbname+' where 1=1';


    

Result := tmpSQL;


  

end


  

else


  

begin


    

//

明细表情况：



    

tmpPropList := pTO.FPropList;


    

tmpSQL := 'select ';


    

for i:=0 to tmpPropList.PropCount-1 do


    

begin


       

case tmpPropList.Props[i]^.PropType^.Kind of


         

tkClass:


           

begin


             

tmpObj := GetObjectProp(pTO, tmpPropList.Props[i]);


             

tmpProp2 := TDataTransferObject(tmpObj).FPropList;


             

tmpTbname := TDataTransferObject(tmpObj).tbName;


 


             

for j:=0 to tmpProp2.PropCount-1 do


             

begin


               

if GetFldName(tmpProp2.PropNames[j])<>'' then


                 

tmpSQL :=  

tmpSQL + tmpTbname +'.'+GetFldName(tmpProp2.PropNames[j]) +','


             

end;


           

end;


       

end;


 


    

end;


 


    

tmpSQL := Copy(tmpSQL,0, length(tmpSQL)-1);


    

tmpSQL := tmpSQL + ' FROM ';


 


    

for i:=0 to tmpPropList.PropCount-1 do


    

begin


       

case tmpPropList.Props[i]^.PropType^.Kind of


         

tkClass:


           

begin


             

tmpObj := GetObjectProp(pTO, tmpPropList.Props[i]);


             

tmpProp2 := TDataTransferObject(tmpObj).FPropList;


             

tmpTbname := TDataTransferObject(tmpObj).tbName;


             

tmpSQL := tmpSQL + tmpTbname+',';


           

end;


       

end;


    

end;


 


    

tmpSQL := Copy(tmpSQL,0, length(tmpSQL)-1);


    

tmpSQL := tmpSQL + ' Where '+pTO.IndexInfo;


 


    

Result := tmpSQL;


 


  

end;


 


end;


 


  

//

明细表：



  

TDetail = class(TDataTransferObject)


  

public


    

person: TPersonBasVO;


    

card: TCardBasVO;


  

published


    

Property Fperson : TPersonBasVO  

index  

0 Read person  

Write person;


    

Property Fcard  

: TCardBasVO index  

1 Read card  

Write card;


  

public


    

constructor Create(tmpPer: TPersonBasVO; tmpCard: TCardBasVO);


  

end;


用法如下：



 


//-----------------------------------------------


  

//

明细表测试



  

//personVO.PK_Dno := '001';


 


  

Detail := TDetail.Create(personVO, CardVO);


  

rdmDS.SelectRDMDS(Detail, ClientDataSet2);


  

//-----------------------------------------------    

}

 

 

philips286
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
DELPHI中使用RTTI
09-09 1007
    运行期类型信息(RTTI)是一种语言特征，能使应用程序在运行时得到关于对象的信息。RTTI是Delphi的组件能够融合到IDE中的关键。它在IDE中不仅仅是一个纯学术的过程。    由于对象都是从TObject继承下来的，因此，对象都包含一个指向它们的RTTI的指针以及几个内建的方法。下面的表列出了TObject的一些方法，用这些方法能获得某个对象实例的信息。
delphi 实现rttl
09-04
delphi 实现rttl delphi
clientDataSet转换sql
weixin_30328063的博客
09-26 611
ReadMe 新版本delphi，可以用string类型，旧版本需要用widestring =========================================== function TFRMSOEDIT.vartosql(value: Variant): wideString;var tmp: widestring;begin if (varisnull(val...
Delphi 三层 界面和逻辑的分离 抽取DAO层
05-30
DELPHI 三层的小例子 界面和逻辑的分离 下载完后，点评论，并点了个星，提交后会把分返回，并再多给一分。
Delphi之MIDAS三层完美解决方案----中间层构建
编程资料收集与共享交流
04-01 2088
思路：中间层与客户端通过三个关键的接口过程进行交互操作(GetData,SetData,GetspData) GetData：获取数据集。客户端传递数据集名称给中间层，中间层根据请求的数据集名称从数据库的配置文件中获取相关信息，与客户的的条件集合一起给合成SQL语句 SetData：提交数据集。客户端传递修改后的数据集Delta与名称给中间层，中间层根据请求的数据集名称从数据库的配置文件中获取相关...
nokia-rttl:在 Nokia Composer 中将 RTTL 符号转换为击键序列
06-17
这个项目“nokia-rttl”显然是一个JavaScript库，它的目标是将RTTL符号转换成实际的按键序列，这样用户就可以根据这些序列在他们的诺基亚手机上输入铃声。 RTTL格式允许用户通过简单的文本描述来创建复杂的旋律。它...
基于Data Abstract框架应用软件开发
10-23
- **实际开发中遇到的问题(DAORMFrameWork的处理)**：Data Abstract框架通过优化数据加载和SQL语句生成等方式提高了性能。 4. **网络通信中的数据传输效率** - **传递对象、对象列表、数据集还是XML**：选择合适...
高级软件工程(第5章形式化开发方法1_Petri网定义).pptx
11-14
形式化开发方法是一种在严格的数学基础上构建的软件开发技术，它强调使用精确的数学表达形式和语义来描述和验证软件系统。这种方法的主要特点是可以使用数学工具进行验证，比如代数方法，同时也能通过算法进行识别和...
嵌入式开发学习路线全生命周期规划
最新发布
07-04
- **STL/RTTL/元编程**: 标准模板库(STL)提供了一系列高效的算法和容器，而元编程则是一种编写能够生成或修改其他代码的代码的技术。 #### 二、数据结构与算法 - **数据结构**: 包括字符串、数组、链表、堆、栈、...
delphi使用SQL的教程1
dipo2207的博客
11-19 246
SQL语言作为关系数据库管理系统中的一种通用的结构查询语言，已经被众多的数据库管理系统所采用，如ORACLE、Sybase、Informix等数据库管理系统，它们都支持SQL语言。Delphi与使用SQL语言的数据库管理系统兼容，在使用Delphi开发数据库应用程序时，我们可以使用SQL语言编程，支持SQL编程是Delphi的一个重要特征，这也是体现Delphi作为一个强大的数据库应用...
Kadao Deluxe
01-25
KADao Deluxe is package which combined with KADao is the most powerfull Delphi suite for using Microsoft DAO and all database formats that DAO supports 15 DAO-specific components for wide range of professional tasks. Comes with full source. It includes KAdaoUser,LADaoField, KADaoError, KADaoBatchMove, KADaoAdo and........ Utilities for those still using MS Access. For Delphi3 - Delphi7. Password : YH7qmdNr
Delphi7数据库编程之TDataSet
kimifdw的专栏
03-21 3992
TDataSet类由TBDEDataSet（BDE组件）、TCustomADODataSet（ADO组件）、TIBCustomDataSet（InterBase组件）、TCustomSQLDataSet（dbExpress组件）和TCustomClientDataSet子类组成。 下面介绍DataSet类中比较重要的属性（可能会有取舍，等到真正做项目用到的时候在进行补充） 1.Active：判
delphi clientdataset 转 sql
从事厨房信息化行业，万能对接所有点餐系统，kds，智能控菜，酒店协调软件
05-28 791
function vartosql(value: Variant): wideString;var  tmp: widestring;begin  if (varisnull(value)) or (varisempty(value)) then    Result := 'NULL'  else    case Vartype(value) of      varDate:        beg...
delphi实现一个类继承抽象类并实现接口
xiao_jun_0820的专栏
09-18 5444
 问题描述：TSaleOutDao即要继承抽象类TABizDao又要实现接口TIBizDao.解决办法：先用抽象类继承TIBizDao,然后再把需要实现的接口方法声明为抽象方法。然后再用TSaleOutDao继承TABizDao.//IBizDao.pas单元文件 unit IBizDao;interfacetype  TIBizDao=interfac
delphi query下的sql动态查询
MAO_JIN_DAO的博客
06-02 2754
delphi query下的sql动态查询效果图 设计视图 所需控件： 1. Query（数据集控件） 2. Datasource（数据访问控件） 3. DBGrid (数据浏览控件) Query->Datadource->DBGrid代码如下procedure TForm1.Button2Click(Sender: TObject); begin if combobox1.
c++中何时会用到 RTTl-dynamic_cast
09-02
如果转换成功，dynamic_cast将生成一个指向派生类的指针；如果转换失败，即无法将指向基类的指针转换为指向派生类的指针，dynamic_cast将返回0，即空指针。 此外，dynamic_cast也可以用于引用类型。与指针不同的是，...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值