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

原文作者：楠楠|wu_yanan2003@yahoo.com.cn
原文出处：本站原创
====================

从一个简单的例子开始。创建一个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;

//明细表：
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);
//----------------------------------------------- }

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。