今天我儿子和我过生日，共享快乐。顺便贡献多年写的delphi数据库封装原代码。 ( 积分: 8 )

---------- 说明 ----------
1. 该代码可以免费使用, 该代码的名字暂时定为"哲别"
2. 如果你需要使用该代码, 请注明该代码的原来作者: Jacky Zhou
3. 如果你发现该代码有bug,可以自己修改或者请给我发email: zyx040404@163.com
4. 该数据库封装代码功能可以对数据库的表,视图和存储过程进行封装,易于系统移植,扩展,使用了interface,factory,xml等方法
5. 核心代码是在"Sample/base/DBGW"里
6. Sample演示了查询,增加,删除记录和如何使用存贮过程

delphibbs不能上传代码，如有需要，请到
http://www.supercss.com/code/8213.htm
下载

如果你没有做过，那这些代码可以用来学习
诚然，这并不是最好的代码，而且中国高人如云
学海无涯

贴一些主要的代码
这是核心代码
unit DBGW;

interface

uses
Windows, Messages, SysUtils, Classes, DB, DBTables, Forms, Contnrs, ADODB, Entity,
EtyList, EntityFactory, UDF, XMLDoc, XMLIntf, DBClient;

const
//stored proc
LOAD_TYPE_TABLE = 'Table';
LOAD_TYPE_STOREDPROC = 'StoredProc';
MAX_DB_CONNECTION = 10;

//field type
ID_FIELD_TYPE_STRING = 'string';

ID_AND = ' AND ';
AND_LENGTH = 5;

type
TDB = class
public
strAliasName : String;
strDatabaseName : String;
strDriverName : String;
bKeepConnection : Boolean;
end;

type
//-----------------------------------------------------------------------------
// Class TdmDBGW
//-----------------------------------------------------------------------------
TdmDBGW = class(TDataModule)
m_db: TDatabase;
procedure DataModuleCreate(Sender: TObject);
procedure m_dbBeforeConnect(Sender: TObject);
procedure m_dbAfterConnect(Sender: TObject);
private
m_strEntityMapPath : string;
m_EntityFactory : IEntityFactory;
m_listAllEntityMapField : TEtyList;

m_StackConnections : TStack;

procedure Init();
procedure InitConnectionPool;
function GetConnection() : TQuery;
procedure ReleaseConnection(connection : TQuery);
protected
function LoadEntityByTable(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
function LoadEntityByStoredProc(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean; virtual;

function GetAllEntityMapField() : TEtyList;
function GetLoadType(const strEntityName : String) : String;
function GetEntityMapField(const strEntityName : String = '') : TEtyList;
function GetTableName(const strEntityName : String) : String;
function GetTableFieldName(const strTableName : String; const strEntityFieldName : String) : String;
function GetTableFieldType(const strTableName : String; const strFieldName : String) : String;
function FormatValueAppToDB(const varFieldValue : Variant; const strFieldType : String) : String;
function FormatValueDBToApp(const varFieldValue : Variant; const strFieldType : String) : Variant;

function GetCondition(const strEntityName : String; const listCondition : TEtyList) : String;
function GetRule(const strEntityName : String; const listRule : TEtyList) : String;
function GetPKCondition(const pety : PIEntity) : String;
public
procedure SetEntityFactory(const factory : IEntityFactory);

function LoadEntity(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
function LoadEntityList(list : TEtyList; const listCondition : TEtyList = nil; const listRule : TEtyList = nil) : Boolean;
function InsertEntity(const pety : PIEntity) : Boolean;
function UpdateEntity(const pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
function DeleteEntity(const pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;

// procedure BeginTrans;

procedure Refresh(etyList : TEtyList);
end;

var
dmDBGW: TdmDBGW;

implementation

uses Variants, EtyEntityMapField, EtyCondition;

{$R *.dfm}

//-----------------------------------------------------------------------------
// Init
//-----------------------------------------------------------------------------
procedure TdmDBGW.Init();
begin
m_strEntityMapPath := GetAppPath() + ID_ENTITY_MAP_PATH + '/';
m_listAllEntityMapField := GetAllEntityMapField;
end;

//-----------------------------------------------------------------------------
// SetEntityFactory
//-----------------------------------------------------------------------------
procedure TdmDBGW.SetEntityFactory(const factory : IEntityFactory);
begin
m_EntityFactory := factory;
end;

//-----------------------------------------------------------------------------
// LoadEntity
//-----------------------------------------------------------------------------
function TdmDBGW.LoadEntity(pety : PIEntity; const listCondition : TEtyList) : Boolean;
var
strLoadType : String;
begin
strLoadType := GetLoadType(pety^.EntityName);
strLoadType := LowerCase(strLoadType);

if strLoadType = LowerCase(LOAD_TYPE_TABLE) then
Result := LoadEntityByTable(pety, listCondition)
else if strLoadType = LowerCase(LOAD_TYPE_STOREDPROC) then
Result := LoadEntityByStoredProc(pety, listCondition)
else
Result := LoadEntityByTable(pety, listCondition);
end;

//-----------------------------------------------------------------------------
// LoadEntityByTable
//-----------------------------------------------------------------------------
function TdmDBGW.LoadEntityByTable(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
var
strTableName : String;
listEntityMapField : TEtyList;
etyEntityMapField : IEntity;
strSQL, strSQLFields, strSQLWhere : String;

i : Integer;
nColumnCounts : Integer;
connection : TQuery;
strFieldType : String;
strFieldName : String;
varFieldValue : Variant;
begin
connection := GetConnection;

try
//get table name
strTableName := GetTableName(pety.GetEntityName);
if strTableName = '' then
begin
Result := false;
exit;
end;

//get table field
listEntityMapField := GetEntityMapField(pety.GetEntityName);

//set SQL's title
strSQLFields := '';
for i := 0 to listEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := listEntityMapField.GetEntity(i);

strTableName := etyEntityMapField.GetAttributeValue(ID_TABLE_NAME);
strFieldName := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME);
strSQLFields := strSQLFields + '[' + strTableName + '].[' + strFieldName + '], ';
end;
//get rid of the last ',' in strSQLFields
strSQLFields := Copy(strSQLFields, 0, Length(strSQLFields) - 2);

//get where
if listCondition <> nil then
strSQLWhere := GetCondition(pety.EntityName, listCondition)
else //if listCondition = nil then only load this pety
strSQLWhere := GetPKCondition(pety);

//it must have strSQLWhere
if strSQLWhere = '' then
begin
result := false;
exit;
end;

//set the sql
strSQL := 'SELECT ' + strSQLFields + ' FROM ' + strTableName + ' WHERE ' + strSQLWhere;

connection.Close;
connection.SQL.Clear;
connection.SQL.Text := strSQL;
connection.Open;

//the result must only be one record
if connection.RecordCount <> 1 then
begin
Result := false;
exit;
end;

//save the data to entity
nColumnCounts := connection.FieldCount;
if nColumnCounts = 0 then
begin
Result := false;
exit
end;
//save data to pety
for i := 0 to nColumnCounts - 1 do
begin
strFieldName := connection.Fields.FieldName;
strFieldType := GetTableFieldType(strTableName, strFieldName);
varFieldValue := FormatValueDBToApp(connection.Fields.AsVariant, strFieldType);
if not VarIsNull(varFieldValue) then
pety.SetAttributeValue(strFieldName, varFieldValue);
end;

Result := true;
finally
ReleaseConnection(connection);
end
end;

//-----------------------------------------------------------------------------
// LoadEntityByStoredProc
//-----------------------------------------------------------------------------
function TdmDBGW.LoadEntityByStoredProc(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
begin
Result := true;
end;

//-----------------------------------------------------------------------------
// LoadEntityList
//-----------------------------------------------------------------------------
function TdmDBGW.LoadEntityList(list : TEtyList; const listCondition : TEtyList = nil; const listRule : TEtyList = nil) : Boolean;
var
connection : TQuery;
strSQL, strSQLFields, strSQLWhere, strSQLRule : String;
listEntityMapField : TEtyList;
etyEntityMapField : IEntity;

i : integer;
strTableName : String;
nColumnCounts : Integer;
strFieldType : String;
strFieldName : String;
varFieldValue : Variant;
ety : IEntity;
begin
connection := GetConnection;

try
list.Clear;

//get table field
listEntityMapField := GetEntityMapField(list.GetEntityName);
strTableName := '';
strSQLFields := '';
strFieldName := '';
for i := 0 to listEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := listEntityMapField.GetEntity(i);

strTableName := etyEntityMapField.GetAttributeValue(ID_TABLE_NAME);
strFieldName := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME);
if (strTableName = '') or (strFieldName = '') then
begin
Result := false;
exit;
end;
strSQLFields := strSQLFields + '[' + strTableName + '].[' + strFieldName + '], ';
end;

//get rid of the last ',' in strSQLFields and strSQLValues
strSQLFields := Copy(strSQLFields, 0, Length(strSQLFields) - 2);

//get table name
strTableName := GetTableName(list.GetEntityName);

//get where
if listCondition <> nil then
strSQLWhere := GetCondition(list.GetEntityName, listCondition);

if strSQLWhere = '' then
strSQL := 'SELECT ' + strSQLFields + ' FROM ' + strTableName
else
strSQL := 'SELECT ' + strSQLFields + ' FROM ' + strTableName + ' WHERE ' + strSQLWhere;

//get rule
if listRule <> nil then
strSQLRule := GetRule(list.GetEntityName, listRule);

if strSQLRule <> '' then
strSQL := strSQL + ' ' + strSQLRule;

//set the sql
connection.Close;
connection.SQL.Clear;
connection.SQL.Text := strSQL;
connection.Open;

//save the data to entity
nColumnCounts := connection.FieldCount;

connection.First;
while not connection.Eof do
begin
//这就是动态创建Entity Class，在Control Class定义DBGW并初始化时给m_EntityFactory赋值
//create new pety from EntityFactory
ety := m_EntityFactory.CreateEntity(list.GetEntityName);
for i := 0 to nColumnCounts - 1 do
begin
strFieldName := connection.Fields.FieldName;
strFieldType := GetTableFieldType(strTableName, strFieldName);
varFieldValue := FormatValueDBToApp(connection.Fields.AsVariant, strFieldType);
if not VarIsNull(varFieldValue) then
ety.SetAttributeValue(strFieldName, varFieldValue);
end;

list.AddEntity(ety);

connection.Next;
end;

Result := true;
finally
ReleaseConnection(connection);
end
end;

//-----------------------------------------------------------------------------
// InsertEntity
//-----------------------------------------------------------------------------
function TdmDBGW.InsertEntity(const pety : PIEntity) : Boolean;
var
strTableName : String;
etyEntityMapField : IEntity;
listEntityMapField : TEtyList;
strSQL, strSQLFields, strSQLValues : String;

strFieldName, strFieldType, strFieldValue : String;
varFieldValue : Variant;
bIsFieldChanged : Boolean;
i : Integer;
connection : TQuery;
begin
connection := GetConnection;

try
//get table name
strTableName := GetTableName(pety.GetEntityName);

//get table field
listEntityMapField := GetEntityMapField(pety.GetEntityName);

//set the insert sql
strSQLFields := '';
strSQLValues := '';

strFieldName := '';
strFieldType := '';
for i := 0 to listEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := listEntityMapField.GetEntity(i);

strFieldName := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME);
bIsFieldChanged := pety.IsAttributeChanged(strFieldName);

//在Insert时候，有些字段的值有值，有些没有，以下的代码是把有值的字段的Name
//写到SQL语句里，没有值的就不需要写. 但是PK必须要有值
if bIsFieldChanged then
begin
strFieldType := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_TYPE);
varFieldValue := pety.GetAttributeValue(strFieldName);

if not VarIsNull(varFieldValue) then
begin
strSQLFields := strSQLFields + '[' + strFieldName + '], ';
strFieldValue := FormatValueAppToDB(varFieldValue, strFieldType);

if strFieldType = ID_FIELD_TYPE_STRING then
strSQLValues := strSQLValues + '''' + strFieldValue + '''' + ', '
else
strSQLValues := strSQLValues + strFieldValue + ', ';
end;
end;
end;

if (strSQLValues = '') then
begin
InsertEntity := false;
exit;
end;

//get rid of the last ',' in strSQLFields and strSQLValues
strSQLFields := Copy(strSQLFields, 0, Length(strSQLFields) - 2);
strSQLValues := Copy(strSQLValues, 0, Length(strSQLValues) - 2);
strSQL := 'INSERT INTO ' + strTableName + '(' + strSQLFields + ') ' + 'VALUES( ' + strSQLValues + ')';

connection.Close;
connection.SQL.Clear;
connection.SQL.Text := strSQL;
connection.ExecSQL;

Result := true;
finally
ReleaseConnection(connection);
end
end;

//-----------------------------------------------------------------------------
// UpdateEntity
//-----------------------------------------------------------------------------
function TdmDBGW.UpdateEntity(const pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
var
strTableName : String;
etyEntityMapField : IEntity;
listEntityMapField : TEtyList;
strSQL, strSQLSet, strSQLWhere : String;

strFieldName, strFieldType, strFieldValue : String;
varFieldValue : Variant;
bIsFieldChanged, bIsPK : Boolean;
i : Integer;
connection : TQuery;
begin
connection := GetConnection;

try
//get table name
strTableName := GetTableName(pety.GetEntityName);

//get table field
listEntityMapField := GetEntityMapField(pety.GetEntityName);

//set the insert sql
strSQLSet := '';
strSQLWhere := '';

strFieldName := '';
strFieldType := '';
for i := 0 to listEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := listEntityMapField.GetEntity(i);

strFieldName := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME);
bIsFieldChanged := pety.IsAttributeChanged(strFieldName);

//在Update时候，有些字段的值改变了，有些没有，以下的代码是把改变的字段的Name
//写到SQL语句里，没有改变的就不需要写
if bIsFieldChanged then
begin
strFieldType := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_TYPE);
bIsPK := etyEntityMapField.GetAttributeValue(ID_ISPK);
varFieldValue := pety.GetAttributeValue(strFieldName);

if (not bIsPK) then
begin
strFieldValue := FormatValueAppToDB(varFieldValue, strFieldType);

if strFieldType = ID_FIELD_TYPE_STRING then
strSQLSet := strSQLSet + '[' + strFieldName + '] = ' + ''''+ strFieldValue + '''' + ', '
else
strSQLSet := strSQLSet + '[' + strFieldName + '] = ' + strFieldValue + ', ';
end;
end;
end;

//get rid of the last ',' in strSQLSet
if (strSQLSet = '') then
begin
UpdateEntity := false;
exit;
end;
strSQLSet := Copy(strSQLSet, 0, Length(strSQLSet) - 2);

//get strSQLWhere
if listCondition <> nil then
strSQLWhere := GetCondition(pety.GetEntityName, listCondition)
else //if listCondition = nil then only update this pety
strSQLWhere := GetPKCondition(pety);

//set strSQL
if strSQLWhere = '' then
strSQL := 'UPDATE ' + strTableName + ' SET ' + strSQLSet
else
strSQL := 'UPDATE ' + strTableName + ' SET ' + strSQLSet + ' WHERE ' + strSQLWhere;

connection.Close;
connection.SQL.Clear;
connection.SQL.Text := strSQL;
connection.ExecSQL;

Result := true;
finally
ReleaseConnection(connection);
end
end;

//-----------------------------------------------------------------------------
// DeleteEntity
//-----------------------------------------------------------------------------
function TdmDBGW.DeleteEntity(const pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
var
strTableName : String;
strSQL, strSQLWhere: String;
connection : TQuery;
begin
connection := GetConnection;

try
//get table name
strTableName := GetTableName(pety.GetEntityName);

if listCondition <> nil then
strSQLWhere := GetCondition(pety.GetEntityName, listCondition)
else //if listCondition = nil then only delete this pety
strSQLWhere := GetPKCondition(pety);

//set strSQL
if strSQLWhere = '' then
strSQL := 'DELETE FROM ' + strTableName
else
strSQL := 'DELETE FROM ' + strTableName + ' WHERE ' + strSQLWhere;

connection.Close;
connection.SQL.Clear;
connection.SQL.Text := strSQL;
connection.ExecSQL;

Result := true;
finally
ReleaseConnection(connection);
end
end;

//-----------------------------------------------------------------------------
// GetCondition
//-----------------------------------------------------------------------------
function TdmDBGW.GetCondition(const strEntityName : String; const listCondition : TEtyList) : String;
var
i : Integer;

strTableName : String;
strSQLWhere : String;
etyCondition : IEntity;
strEntityFieldName, strOperation, strValue : String;
strTableFieldName, strTableFieldType : String;
begin
try
if listCondition = nil then
begin
Result := '';
exit;
end;

strTableName := GetTableName(strEntityName);

strSQLWhere := '';
for i := 0 to listCondition.GetEntityCount - 1 do
begin
etyCondition := listCondition.GetEntity(i);

strEntityFieldName := etyCondition.GetAttributeValue(FD_ENTITY_FIELD_NAME);
strTableFieldName := GetTableFieldName(strTableName, strEntityFieldName);
strTableFieldType := GetTableFieldType(strTableName, strTableFieldName);
strOperation := etyCondition.GetAttributeValue(FD_OPERATION);
strValue := etyCondition.GetAttributeValue(FD_VALUE);

if strTableFieldType = ID_FIELD_TYPE_STRING then
strSQLWhere := strSQLWhere + '[' + strTableName + '].[' + strTableFieldName +']' + strOperation + '''' + strValue + ''''+ ID_AND
else
strSQLWhere := strSQLWhere + '[' + strTableName + '].[' + strTableFieldName +']' + strOperation + strValue + ID_AND;
end;

//get rid of the last ID_AND in strSQLWhere
strSQLWhere := Copy(strSQLWhere, 0, Length(strSQLWhere) - AND_LENGTH);

Result := strSQLWhere;
except
Result := '';
end
end;

//-----------------------------------------------------------------------------
// GetRule
//-----------------------------------------------------------------------------
function TdmDBGW.GetRule(const strEntityName : String; const listRule : TEtyList) : String;
var
i : Integer;

strTableName : String;
strSQLRule : String;
etyRule : IEntity;
strEntityFieldName, strOperation : String;
strTableFieldName : String;
begin
try
if listRule = nil then
begin
Result := '';
exit;
end;

strTableName := GetTableName(strEntityName);

strSQLRule := '';
for i := 0 to listRule.GetEntityCount - 1 do
begin
etyRule := listRule.GetEntity(i);

strEntityFieldName := etyRule.GetAttributeValue(FD_ENTITY_FIELD_NAME);
strTableFieldName := GetTableFieldName(strTableName, strEntityFieldName);
strOperation := etyRule.GetAttributeValue(FD_OPERATION);

strSQLRule := strSQLRule + strOperation + ' [' + strTableName + '].[' + strTableFieldName +']' + ID_AND;
end;

//get rid of the last ID_AND in strSQLRule
strSQLRule := Copy(strSQLRule, 0, Length(strSQLRule) - AND_LENGTH);

Result := strSQLRule;
except
Result := '';
end
end;

//-----------------------------------------------------------------------------
// GetPKCondition
//-----------------------------------------------------------------------------
function TdmDBGW.GetPKCondition(const pety : PIEntity) : String;
var
strCondition : String;
listEntityMapField : TEtyList;
etyEntityMapField : IEntity;

i, nFieldCount : Integer;
strFieldName, strFieldType, strFieldValue : String;
bIsPK : Boolean;
begin
try
//get Table Field
listEntityMapField := GetEntityMapField(pety.EntityName);
nFieldCount := listEntityMapField.GetEntityCount;
if (nFieldCount = 0) then
begin
Result := '';
exit;
end;

strCondition := '';
strFieldName := '';
strFieldType := '';
strFieldValue := '';
for i := 0 to nFieldCount - 1 do
begin
etyEntityMapField := listEntityMapField.GetEntity(i);

strFieldName := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME);
strFieldType := etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_TYPE);
bIsPK := etyEntityMapField.GetAttributeValue(ID_ISPK);

if bIsPK then
begin
strFieldValue := pety.GetAttributeValue(strFieldName);
//if pk is '', then we can not get pk
if (strFieldValue = '') then
begin
result := '';
exit;
end;

strFieldValue := FormatValueDBToApp(strFieldValue, strFieldType);

if strFieldType = ID_FIELD_TYPE_STRING then
strCondition := strCondition + strFieldName + '=' + '''' + strFieldValue + '''' + ID_AND
else
strCondition := strCondition + strFieldName + '=' + strFieldValue + ID_AND;
end;
end;

//get rid of the last ID_AND in strCondition
strCondition := Copy(strCondition, 0, Length(strCondition) - AND_LENGTH);

Result := strCondition;
except
Result := '';
end
end;

//-----------------------------------------------------------------------------
// FormatValueAppToDB和FormatValueDBToApp方法暂时还没有完善
// 这两个方法是用来格式化值，因为UI层的数据显示可能和数据库的值不一样
// 所以需要转换一下
//-----------------------------------------------------------------------------

//-----------------------------------------------------------------------------
// FormatValueAppToDB
//-----------------------------------------------------------------------------
function TdmDBGW.FormatValueAppToDB(const varFieldValue : Variant; const strFieldType : String) : String;
begin
try
if VarIsNull(varFieldValue) then
Result := 'NULL'
else
Result := varFieldValue;
except
Result := '';
end
end;

//-----------------------------------------------------------------------------
// FormatValueDBToApp
//-----------------------------------------------------------------------------
function TdmDBGW.FormatValueDBToApp(const varFieldValue : Variant; const strFieldType : String) : Variant;
begin
try
if VarIsNull(varFieldValue) then
begin
if strFieldType = 'string' then
Result := ''
else if strFieldType = 'int' then
Result := 0
else
//This is set to 'NULL', it is will used in many places. so, we should be careful it
// Result := 'NULL';
Result := varFieldValue;
end
else
Result := varFieldValue;
except
Result := '';
end
end;

//-----------------------------------------------------------------------------
// InitConnectionPool
//-----------------------------------------------------------------------------
procedure TdmDBGW.InitConnectionPool;
var
i : Integer;
connection : TQuery;
begin
try
m_StackConnections := TStack.Create;

for i := 1 to MAX_DB_CONNECTION do
begin
connection := TQuery.Create(self);
connection.AutoCalcFields := true;
connection.DatabaseName := m_db.DatabaseName;

m_StackConnections.Push(connection);
end;
except

end
end;

//-----------------------------------------------------------------------------
// GetConnection
//-----------------------------------------------------------------------------
function TdmDBGW.GetConnection() : TQuery;
begin
Result := m_StackConnections.Pop;
end;

//-----------------------------------------------------------------------------
// GetConnection
//-----------------------------------------------------------------------------
procedure TdmDBGW.ReleaseConnection(connection : TQuery);
begin
m_StackConnections.Push(connection);
end;

//-----------------------------------------------------------------------------
// Refresh
//-----------------------------------------------------------------------------
procedure TdmDBGW.Refresh(etyList : TEtyList);
begin
LoadEntityList(etyList);
end;

//-----------------------------------------------------------------------------
// GetAllEntityMapField
// 该方法获得all Entity Class对应的Field
//-----------------------------------------------------------------------------
function TdmDBGW.GetAllEntityMapField() : TEtyList;
var
xmlFile : TXMLDocument;
list : IXMLNodeList;

i : Integer;
etyEntityMapField : IEntity;
listEntityMapField : TEtyList;
strXMLFileName, strEntityName, strTableName, strValue : String;

handle : Cardinal;
win32FindData : WIN32_FIND_DATA;
strFileName : string;

label Label_Continue;
label Label_Exit;
begin
xmlFile := TXMLDocument.Create(self);
listEntityMapField := TEtyList.Create(TEtyEntityMapField.Create);

try
strFileName := m_strEntityMapPath + '*.xml';

handle := FindFirstFile(PChar(strFileName), win32FindData);
if (handle = INVALID_HANDLE_VALUE) then
begin
result := nil;
exit;
end;

while (true) do
begin
//scan xml files
if (win32FindData.cFileName[0] = '.') or (win32FindData.cFileName = '..') then
goto Label_Continue;

strXMLFileName := m_strEntityMapPath + win32FindData.cFileName;

//get entity map file name
xmlFile.LoadFromFile(strXMLFileName);
xmlFile.Active := true;

list := xmlFile.DocumentElement.ChildNodes[ID_FIELDS].ChildNodes;

strEntityName := xmlFile.DocumentElement.ChildNodes[ID_ENTITY_NAME].NodeValue;
strTableName := xmlFile.DocumentElement.ChildNodes[ID_TABLE_NAME].NodeValue;

//save the data to entity
for i := 0 to list.Count - 1 do
begin
etyEntityMapField := TEtyEntityMapField.Create;

//entity name
etyEntityMapField.SetAttributeValue(ID_ENTITY_NAME, strEntityName);

//entity field name
strValue := list.ChildNodes[FD_ENTITY_FIELD_NAME].NodeValue;
etyEntityMapField.SetAttributeValue(FD_ENTITY_FIELD_NAME, strValue);

//table name
etyEntityMapField.SetAttributeValue(ID_TABLE_NAME, strTableName);

//table field name
strValue := list.ChildNodes[ID_TABLE_FIELD_NAME].NodeValue;
etyEntityMapField.SetAttributeValue(ID_TABLE_FIELD_NAME, strValue);

//field type
strValue := list.ChildNodes[ID_TABLE_FIELD_TYPE].NodeValue;
etyEntityMapField.SetAttributeValue(ID_TABLE_FIELD_TYPE, strValue);

//is pk
strValue := list.ChildNodes[ID_ISPK].NodeValue;
etyEntityMapField.SetAttributeValue(ID_ISPK, strValue);

//add etyEntityMapField to listEntityMapField
listEntityMapField.AddEntity(etyEntityMapField);
end;

Label_Continue:
if not FindNextFile(handle, win32FindData) then
goto Label_Exit;
end;

Label_Exit:
Result := listEntityMapField;
finally
xmlFile.Free;
end
end;

//-----------------------------------------------------------------------------
// GetEntityMapField
// 该方法获得Entity Class对应的Field
//-----------------------------------------------------------------------------
function TdmDBGW.GetEntityMapField(const strEntityName : String = '') : TEtyList;
var
i : Integer;
etyEntityMapField : IEntity;
listEntityMapField : TEtyList;
begin
listEntityMapField := TEtyList.Create(TEtyEntityMapField.Create);

for i := 0 to m_listAllEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := m_listAllEntityMapField.GetEntity(i);

if (Trim(LowerCase(etyEntityMapField.GetAttributeValue(ID_ENTITY_NAME))) = Trim(LowerCase(strEntityName))) then
begin
//add etyEntityMapField to listEntityMapField
listEntityMapField.AddEntity(etyEntityMapField);
end;
end;

Result := listEntityMapField;
end;

//-----------------------------------------------------------------------------
// GetTableName
//-----------------------------------------------------------------------------
function TdmDBGW.GetTableName(const strEntityName : String) : String;
var
xmlFile : TXMLDocument;
begin
xmlFile := TXMLDocument.Create(self);

try
//get entity map file name
xmlFile.LoadFromFile(GetAppPath() + ID_ENTITY_MAP_PATH + '/' + strEntityName + '.xml');
xmlFile.Active := true;

Result := xmlFile.DocumentElement.ChildNodes[ID_TABLE_NAME].NodeValue;
finally
xmlFile.Free;
end
end;

//-----------------------------------------------------------------------------
// GetTableFieldName
//-----------------------------------------------------------------------------
function TdmDBGW.GetTableFieldName(const strTableName : String; const strEntityFieldName : String) : String;
var
i : Integer;
etyEntityMapField : IEntity;
begin
try
for i := 0 to m_listAllEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := m_listAllEntityMapField.GetEntity(i);
if (Trim(LowerCase(etyEntityMapField.GetAttributeValue(ID_TABLE_NAME))) = Trim(LowerCase(strTableName))) and
(Trim(LowerCase(etyEntityMapField.GetAttributeValue(ID_ENTITY_FIELD_NAME))) = Trim(LowerCase(strEntityFieldName))) then
begin
Result := Trim(etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME));
exit;
end;
end;

Result := '';
except
Result := '';
end;
end;

//-----------------------------------------------------------------------------
// GetLoadType
//-----------------------------------------------------------------------------
function TdmDBGW.GetLoadType(const strEntityName : String) : String;
var
xmlFile : TXMLDocument ;
begin
//get entity map file name
xmlFile := TXMLDocument.Create(self);
xmlFile.LoadFromFile(GetAppPath() + ID_ENTITY_MAP_PATH + '/' + strEntityName + '.xml');
xmlFile.Active := true;

result := xmlFile.DocumentElement.ChildNodes.Nodes[ID_LOAD_TYPE].NodeValue;

xmlFile.Free;
end;

//-----------------------------------------------------------------------------
// GetTableFieldType
//-----------------------------------------------------------------------------
function TdmDBGW.GetTableFieldType(const strTableName : String; const strFieldName : String) : String;
var
i : Integer;
etyEntityMapField : IEntity;
begin
try
for i := 0 to m_listAllEntityMapField.GetEntityCount - 1 do
begin
etyEntityMapField := m_listAllEntityMapField.GetEntity(i);
if (Trim(LowerCase(etyEntityMapField.GetAttributeValue(ID_TABLE_NAME))) = Trim(LowerCase(strTableName))) and
(Trim(LowerCase(etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_NAME))) = Trim(LowerCase(strFieldName))) then
begin
Result := Trim(etyEntityMapField.GetAttributeValue(ID_TABLE_FIELD_TYPE));
exit;
end;
end;

Result := '';
except
Result := '';
end
end;

//-----------------------------------------------------------------------------
// DataModuleCreate
//-----------------------------------------------------------------------------
procedure TdmDBGW.DataModuleCreate(Sender: TObject);
begin
//it is implemented by derived classes
end;

//-----------------------------------------------------------------------------
// m_dbBeforeConnect
//-----------------------------------------------------------------------------
procedure TdmDBGW.m_dbBeforeConnect(Sender: TObject);
begin
//it is implemented by derived classes
end;

//-----------------------------------------------------------------------------
// m_dbAfterConnect
//-----------------------------------------------------------------------------
procedure TdmDBGW.m_dbAfterConnect(Sender: TObject);
begin
InitConnectionPool;

Init;
end;

end.

这是基类Entity

unit Entity;

interface

uses
SysUtils;

type
IEntity = interface(IInterface)
function GetEntityName() : String;

function GetAttributeValue(strAttributeName : String) : Variant; overload;
procedure SetAttributeValue(strAttributeName : String; varAttributeValue : Variant); overload;
function IsAttributeChanged(strAttributeName : String) : Boolean; overload;

procedure SetChangedFlag(bFlag : Boolean);
procedure ClearValue();
function IsClearValue() : boolean;

property EntityName : String read GetEntityName;
end;

PIEntity = ^IEntity;

implementation

end.

这是Factory基类

unit EntityFactory;

interface

uses Entity;

type
IEntityFactory = interface(IInterface)
function CreateEntity(strEntityName : String) : IEntity;
end;

PIEntityFactory = ^IEntityFactory;

implementation

end.

我儿子和我过生日.

你和你儿子是同一天的生日吗？
这么幸福？
真是羡幕啊！

这是Entity List类

unit EtyList;

interface

uses
Classes, Entity;

type
TEtyList = class
private
m_List : TInterfaceList;
m_strEntityName : String;

function Validate(nIndex : Integer) : Boolean;
public
constructor Create(ety : IEntity) overload;

function GetEntityName() : String;
function GetEntityCount() : Integer;

function AddEntity(ety : IEntity) : Integer;
function RemoveEntity(nIndex : Integer) : Integer;
function GetEntity(nIndex : Integer) : IEntity;

procedure Clear;

procedure Exchange(nIndex1 : Integer; nIndex2 : Integer);
end;

PTEtyList = ^TEtyList;

implementation

//-----------------------------------------------------------------------------
// Create
//-----------------------------------------------------------------------------
constructor TEtyList.Create(ety : IEntity);
begin
inherited Create;

m_List := TInterfaceList.Create;
m_strEntityName := ety.EntityName;
end;

//-----------------------------------------------------------------------------
// GetEntityName
//-----------------------------------------------------------------------------
function TEtyList.GetEntityName() : String;
begin
Result := m_strEntityName;
end;

//-----------------------------------------------------------------------------
// GetEntityCount
//-----------------------------------------------------------------------------
function TEtyList.GetEntityCount() : Integer;
begin
Result := m_list.Count;
end;

//-----------------------------------------------------------------------------
// AddEntity
//-----------------------------------------------------------------------------
function TEtyList.AddEntity(ety : IEntity) : Integer;
begin
Result := m_List.Add(ety);
end;

//-----------------------------------------------------------------------------
// RemoveEntity
//-----------------------------------------------------------------------------
function TEtyList.RemoveEntity(nIndex : Integer) : Integer;
begin
try
if Validate(nIndex) then
Result := m_List.Remove(m_List.Items[nIndex])
else
Result := -1;
except
Result := -1;
end;
end;

//-----------------------------------------------------------------------------
// GetEntity
//-----------------------------------------------------------------------------
function TEtyList.GetEntity(nIndex : Integer) : IEntity;
begin
try
if Validate(nIndex) then
Result := IEntity(m_List.items[nIndex])
else
Result := nil;
except
Result := nil;
end;
end;

//-----------------------------------------------------------------------------
// Validate
//-----------------------------------------------------------------------------
function TEtyList.Validate(nIndex : Integer) : Boolean;
begin
try
if (nIndex < 0) or (nIndex > m_List.Count - 1) then
Result := false
else
Result := true;
except
Result := false;
end;
end;

//-----------------------------------------------------------------------------
// Clear
//-----------------------------------------------------------------------------
procedure TEtyList.Clear;
begin
//bug, Clear does not really release the memoery
m_List.Clear;
end;

//-----------------------------------------------------------------------------
// Exchange
//-----------------------------------------------------------------------------
procedure TEtyList.Exchange(nIndex1 : Integer; nIndex2 : Integer);
begin
m_List.Exchange(nIndex1, nIndex2);
end;

end.

是幸福，我儿子和我是同一天生日

呵呵，好人哦，儿子跟老头一起过生日少见哦
祝你们爷俩生日快乐哦
呵呵

祝你们生日快乐！
谢谢你的源码！

这是Entity XML文件对应的数据库字段的类

unit EtyEntityMapField;

interface

uses
SysUtils, Entity;

const
ENTITY_NAME = 'EntityMapField';

//entity map field
ID_ENTITY_MAP_PATH = 'EntityMap';
ID_LOAD_TYPE = 'LoadType';
ID_FIELDS = 'Fields';
ID_ENTITY_NAME = 'EntityName';
ID_ENTITY_FIELD_NAME = 'EntityFieldName';
ID_TABLE_NAME = 'TableName';
ID_TABLE_FIELD_NAME = 'TableFieldName';
ID_TABLE_FIELD_TYPE = 'TableFieldType';
ID_ISPK = 'IsPK';

type
TEtyEntityMapField = class(TInterfacedObject, IEntity)
private
EntityName : String;
EntityFieldName : String;
TableName : String;
TableFieldName : String;
TableFieldType : String;
IsPK : Boolean;
m_bIsClearValue : boolean;
public
function GetEntityName() : String;

procedure SetAttributeValue(strAttributeName : String; varAttributeValue : Variant);
function GetAttributeValue(strAttributeName : String) : Variant;

function IsAttributeChanged(strAttributeName : String) : Boolean;
procedure SetChangedFlag(bFlag : Boolean);
procedure ClearValue();
function IsClearValue() : boolean;
end;

implementation

//-----------------------------------------------------------------------------
// GetEntityName
//-----------------------------------------------------------------------------
function TEtyEntityMapField.GetEntityName() : String;
begin
// Result := ENTITY_NAME;
Result := 'EntityMapField';
end;

//-----------------------------------------------------------------------------
// SetAttributeValue
//-----------------------------------------------------------------------------
procedure TEtyEntityMapField.SetAttributeValue(strAttributeName : String; varAttributeValue : Variant);
begin
try
strAttributeName := LowerCase(strAttributeName);

if (strAttributeName = LowerCase(ID_ENTITY_NAME)) then
begin
EntityName := varAttributeValue;
end
else if (strAttributeName = LowerCase(ID_ENTITY_FIELD_NAME)) then
begin
EntityFieldName := varAttributeValue;
end
else if (strAttributeName = LowerCase(ID_TABLE_NAME)) then
begin
TableName := varAttributeValue
end
else if (strAttributeName = LowerCase(ID_TABLE_FIELD_NAME)) then
begin
TableFieldName := varAttributeValue
end
else if (strAttributeName = LowerCase(ID_TABLE_FIELD_TYPE)) then
begin
TableFieldType := varAttributeValue
end
else if (strAttributeName = LowerCase(ID_ISPK)) then
begin
IsPK := varAttributeValue
end;
Except

end
end;

//-----------------------------------------------------------------------------
// GetAttributeValue
//-----------------------------------------------------------------------------
function TEtyEntityMapField.GetAttributeValue(strAttributeName : String) : Variant;
var
varAttributeValue : Variant;
begin
try
strAttributeName := LowerCase(strAttributeName);

if (strAttributeName = LowerCase(ID_ENTITY_NAME)) then
varAttributeValue := EntityName
else if (strAttributeName = LowerCase(ID_ENTITY_FIELD_NAME)) then
varAttributeValue := EntityFieldName
else if (strAttributeName = LowerCase(ID_TABLE_NAME)) then
varAttributeValue := TableName
else if (strAttributeName = LowerCase(ID_TABLE_FIELD_NAME)) then
varAttributeValue := TableFieldName
else if (strAttributeName = LowerCase(ID_TABLE_FIELD_TYPE)) then
varAttributeValue := TableFieldType
else if (strAttributeName = LowerCase(ID_ISPK)) then
varAttributeValue := IsPK;

Result := varAttributeValue;
Except

end
end;

//-----------------------------------------------------------------------------
// IsAttributeChanged
//-----------------------------------------------------------------------------
function TEtyEntityMapField.IsAttributeChanged(strAttributeName : String) : Boolean;
begin
Result := true;
end;

//-----------------------------------------------------------------------------
// IsAttributeChanged
//-----------------------------------------------------------------------------
procedure TEtyEntityMapField.SetChangedFlag(bFlag : Boolean);
begin

end;

//-----------------------------------------------------------------------------
// ClearValue
//-----------------------------------------------------------------------------
procedure TEtyEntityMapField.ClearValue();
begin

end;

//-----------------------------------------------------------------------------
// IsClearValue
//-----------------------------------------------------------------------------
function TEtyEntityMapField.IsClearValue() : boolean;
begin
result := m_bIsClearValue;
end;

end.

这是生成SQL语句时用的条件类

unit EtyCondition;

interface

uses
SysUtils, Entity;

const ENTITY_NAME : String = 'ETYCONDITION';

const FD_ENTITY_FIELD_NAME : String = 'EntityFieldName';
const FD_OPERATION : String = 'Operation';
const FD_VALUE : String = 'Value';

type
TEtyCondition = class(TInterfacedObject, IEntity)
private
EntityFieldName : String;
Operation : String;
Value : String;
m_bIsClearValue : boolean;
public
function GetEntityName() : String;

function GetAttributeValue(strAttributeName : String) : Variant;
procedure SetAttributeValue(strAttributeName : String; varAttributeValue : Variant);

function IsAttributeChanged(strAttributeName : String) : Boolean;
procedure SetChangedFlag(bFlag : Boolean);
procedure ClearValue();
function IsClearValue() : boolean;
end;

implementation

//-----------------------------------------------------------------------------
// GetEntityName
//-----------------------------------------------------------------------------
function TEtyCondition.GetEntityName() : String;
begin
Result := ENTITY_NAME;
end;

//-----------------------------------------------------------------------------
// SetAttributeValue
//-----------------------------------------------------------------------------
procedure TEtyCondition.SetAttributeValue(strAttributeName : String; varAttributeValue : Variant);
begin
strAttributeName := LowerCase(strAttributeName);

if (strAttributeName = LowerCase(FD_ENTITY_FIELD_NAME)) then
EntityFieldName := varAttributeValue
else if (strAttributeName = LowerCase(FD_OPERATION)) then
Operation := varAttributeValue
else if (strAttributeName = LowerCase(FD_VALUE)) then
Value := varAttributeValue;
end;

//-----------------------------------------------------------------------------
// GetAttributeValue
//-----------------------------------------------------------------------------
function TEtyCondition.GetAttributeValue(strAttributeName : String) : Variant;
var
varAttributeValue : Variant;
begin
strAttributeName := LowerCase(strAttributeName);

if (strAttributeName = LowerCase(FD_ENTITY_FIELD_NAME)) then
varAttributeValue := EntityFieldName
else if (strAttributeName = LowerCase(FD_OPERATION)) then
varAttributeValue := Operation
else if (strAttributeName = LowerCase(FD_VALUE)) then
varAttributeValue := Value
else
varAttributeValue := '';

GetAttributeValue := varAttributeValue;
end;

//-----------------------------------------------------------------------------
// IsAttributeChanged
//-----------------------------------------------------------------------------
function TEtyCondition.IsAttributeChanged(strAttributeName : String) : Boolean;
begin
Result := false;
end;

//-----------------------------------------------------------------------------
// SetChangedFlag
//-----------------------------------------------------------------------------
procedure TEtyCondition.SetChangedFlag(bFlag : Boolean);
begin

end;

//-----------------------------------------------------------------------------
// ClearValue
//-----------------------------------------------------------------------------
procedure TEtyCondition.ClearValue();
begin

end;

//-----------------------------------------------------------------------------
// IsClearValue
//-----------------------------------------------------------------------------
function TEtyCondition.IsClearValue() : boolean;
begin
result := m_bIsClearValue;
end;

end.

这是生成SQL语句时用的规则类，比如Order By等

unit EtyRule;

interface

uses
SysUtils, Entity;

const
ENTITY_NAME = 'ETYRULE';

RULE_ORDERBY = 'ORDER BY';
FD_ENTITY_FIELD_NAME = 'EntityFieldName';
FD_OPERATOIN = 'Operation';

type
TEtyRule = class(TInterfacedObject, IEntity)
private
Operation : String;
EntityFieldName : String;
m_bIsClearValue : boolean;
public
function GetEntityName() : String;

function GetAttributeValue(strAttributeName : String) : Variant;
procedure SetAttributeValue(strAttributeName : String; varAttributeValue : Variant);

function IsAttributeChanged(strAttributeName : String) : Boolean;
procedure SetChangedFlag(bFlag : Boolean);
procedure ClearValue();
function IsClearValue() : boolean;
end;

implementation

//-----------------------------------------------------------------------------
// GetEntityName
//-----------------------------------------------------------------------------
function TEtyRule.GetEntityName() : String;
begin
Result := ENTITY_NAME;
end;

//-----------------------------------------------------------------------------
// SetAttributeValue
//-----------------------------------------------------------------------------
procedure TEtyRule.SetAttributeValue(strAttributeName : String; varAttributeValue : Variant);
begin
try
strAttributeName := LowerCase(strAttributeName);

if (strAttributeName = LowerCase(FD_ENTITY_FIELD_NAME)) then
EntityFieldName := varAttributeValue
else if (strAttributeName = LowerCase(FD_OPERATOIN)) then
Operation := varAttributeValue;
Except

end
end;

//-----------------------------------------------------------------------------
// GetAttributeValue
//-----------------------------------------------------------------------------
function TEtyRule.GetAttributeValue(strAttributeName : String) : Variant;
var
varAttributeValue : Variant;
begin
try
strAttributeName := LowerCase(strAttributeName);

if (strAttributeName = LowerCase(FD_ENTITY_FIELD_NAME)) then
varAttributeValue := EntityFieldName
else if (strAttributeName = LowerCase(FD_OPERATOIN)) then
varAttributeValue := Operation
else
varAttributeValue := '';

GetAttributeValue := varAttributeValue;
Except
GetAttributeValue := '';
end
end;

//-----------------------------------------------------------------------------
// IsAttributeChanged
//-----------------------------------------------------------------------------
function TEtyRule.IsAttributeChanged(strAttributeName : String) : Boolean;
begin
Result := false;
end;

//-----------------------------------------------------------------------------
// SetChangedFlag
//-----------------------------------------------------------------------------
procedure TEtyRule.SetChangedFlag(bFlag : Boolean);
begin

end;


//-----------------------------------------------------------------------------
// ClearValue
//-----------------------------------------------------------------------------
procedure TEtyRule.ClearValue();
begin

end;

//-----------------------------------------------------------------------------
// IsClearValue
//-----------------------------------------------------------------------------
function TEtyRule.IsClearValue() : boolean;
begin
result := m_bIsClearValue;
end;

end.

这是factory类
unit FtySample;

interface

uses SysUtils, EntityFactory, Entity, EtyUser, EtySumAge;

type
TFtySample = class(TInterfacedObject, IEntityFactory)
public
function CreateEntity(strEntityName : String) : IEntity;
end;

implementation

//-----------------------------------------------------------------------------
// CreateEntity
//-----------------------------------------------------------------------------
function TFtySample.CreateEntity(strEntityName : String) : IEntity;
begin
strEntityName := LowerCase(strEntityName);

if (strEntityName = LowerCase(TEtyUser.Create.GetEntityName)) then
Result := TEtyUser.Create
else if (strEntityName = LowerCase(TEtySumAge.Create.GetEntityName)) then
Result := TEtySumAge.Create
else
Result := nil;
end;

end.

在这里封装数据库存贮过程
unit SampleDBGW;

interface

uses
SysUtils, Classes, DBGW, DB, DBTables, Entity, EtyList;

const
//sp_GetSequence
ID_FROM_AGE = 'nFromAge';
ID_TO_AGE = 'nToAge';
SP_GET_SUM_AGE = 'sp_GetSumAge';

type
TdmSampleDBGW = class(TdmDBGW)
procedure DataModuleCreate(Sender: TObject);
procedure m_dbBeforeConnect(Sender: TObject);
private
m_spGetSumAge: TStoredProc;
function InitSPGetSumAge() : Boolean;
function SP_GetSumAge(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
public
function LoadEntityByStoredProc(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean; override;
end;

var
dmSampleDBGW: TdmSampleDBGW;

implementation

uses Variants, EtyCondition;

//-----------------------------------------------------------------------------
// DataModuleCreate
//-----------------------------------------------------------------------------
procedure TdmSampleDBGW.DataModuleCreate(Sender: TObject);
begin
try
inherited;

m_db.Close;

//init m_db
m_db.AliasName := 'Sample_SQLServer';
m_db.DatabaseName := 'DB_Sample';
m_db.LoginPrompt := false;

m_db.Open;

//init stored procedures
InitSPGetSumAge;
except

end;
end;

//-----------------------------------------------------------------------------
// m_dbBeforeConnect
//-----------------------------------------------------------------------------
procedure TdmSampleDBGW.m_dbBeforeConnect(Sender: TObject);
begin
inherited;

if m_db.LoginPrompt = false then
begin
m_db.Params.Values['USER NAME'] := 'sa';
m_db.Params.Values['PASSWORD'] := '';
end;
end;

//-----------------------------------------------------------------------------
// LoadEntityByStoredProc
//-----------------------------------------------------------------------------
function TdmSampleDBGW.LoadEntityByStoredProc(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
var
strEntityName : String;
begin
try
strEntityName := LowerCase(pety.EntityName);

if strEntityName = LowerCase('EtySumAge') then
begin
m_spGetSumAge.Destroy;
m_spGetSumAge := TStoredProc.Create(self);
m_spGetSumAge.DatabaseName := m_db.DatabaseName;
m_spGetSumAge.StoredProcName := SP_GET_SUM_AGE;

TParam.Create(m_spGetSumAge.Params, ptInput);
TParam.Create(m_spGetSumAge.Params, ptInput);
m_spGetSumAge.Params[0].Name := ID_FROM_AGE;
m_spGetSumAge.Params[1].Name := ID_TO_AGE;

Result := SP_GetSumAge(pety, listCondition);
end
else
Result := false;
except
Result := false;
end;
end;

//-----------------------------------------------------------------------------
// InitSPGetSumAge
//-----------------------------------------------------------------------------
function TdmSampleDBGW.InitSPGetSumAge() : Boolean;
begin
try
m_spGetSumAge := TStoredProc.Create(self);
m_spGetSumAge.DatabaseName := m_db.DatabaseName;
m_spGetSumAge.StoredProcName := SP_GET_SUM_AGE;

TParam.Create(m_spGetSumAge.Params, ptInput);
TParam.Create(m_spGetSumAge.Params, ptInput);
m_spGetSumAge.Params[0].Name := ID_FROM_AGE;
m_spGetSumAge.Params[1].Name := ID_TO_AGE;

Result := true;
except
Result := false;
end;
end;

//-----------------------------------------------------------------------------
// SP_GetSumAge
//-----------------------------------------------------------------------------
function TdmSampleDBGW.SP_GetSumAge(pety : PIEntity; const listCondition : TEtyList = nil) : Boolean;
var
nFromAge, nToAge : integer;
etyCondition : IEntity;

i : Integer;
nColumnCounts : Integer;
strTableName : String;
strFieldType : String;
strFieldName : String;
varFieldValue : Variant;
begin
try
if m_spGetSumAge.ParamCount <> 2 then
begin
Result := false;
exit;
end;

//get nFromAge and nToAge
if listCondition.GetEntityCount = 0 then
begin
m_spGetSumAge.ParamByName(ID_FROM_AGE).AsInteger := 0;
m_spGetSumAge.ParamByName(ID_TO_AGE).AsInteger := 0;
end
else if listCondition.GetEntityCount = 1 then
begin
etyCondition := listCondition.GetEntity(0);
nFromAge := etyCondition.GetAttributeValue(FD_VALUE);
m_spGetSumAge.ParamByName(ID_FROM_AGE).AsInteger := nFromAge;
m_spGetSumAge.ParamByName(ID_TO_AGE).AsInteger := 0;
end
else if listCondition.GetEntityCount = 2 then
begin
etyCondition := listCondition.GetEntity(0);
nFromAge := etyCondition.GetAttributeValue(FD_VALUE);
m_spGetSumAge.ParamByName(ID_FROM_AGE).AsInteger := nFromAge;

etyCondition := listCondition.GetEntity(1);
nToAge := etyCondition.GetAttributeValue(FD_VALUE);
m_spGetSumAge.ParamByName(ID_TO_AGE).AsInteger := nToAge;
end;

//run storedproc
m_spGetSumAge.Close;
m_spGetSumAge.Prepare;
m_spGetSumAge.Open;

//the result must only be one record
if m_spGetSumAge.RecordCount <> 1 then
begin
Result := false;
exit;
end;

//get table name
strTableName := GetTableName(pety^.GetEntityName);

//save data to pety
nColumnCounts := m_spGetSumAge.FieldCount;
if nColumnCounts = 0 then
begin
Result := false;
exit
end;

for i := 0 to nColumnCounts - 1 do
begin
strFieldName := m_spGetSumAge.Fields.FieldName;
strFieldType := GetTableFieldType(strTableName, strFieldName);
varFieldValue := FormatValueDBToApp(m_spGetSumAge.Fields.AsVariant, strFieldType);
if not VarIsNull(varFieldValue) then
pety^.SetAttributeValue(strFieldName, varFieldValue);
end;

Result := true;
except
Result := false;
end;
end;

end.

呵呵，学习

越看偶越是菜鸟.
唉.自学D一年多了.看到别人的东东真是厉害.

高手是如何修炼出来的啊.

这是Insert数据的方法

//-----------------------------------------------------------------------------
// Add Entity
//-----------------------------------------------------------------------------
procedure TForm1.cmdAddClick(Sender: TObject);
var
etyUser : IEntity;
begin
//get user name condition
if txtUserName.Text = '' then
begin
Application.MessageBox('please input user name', 'Error');
exit;
end;

etyUser := TEtyUser.Create;

etyUser.SetAttributeValue(FD_USER_NAME, txtUserName.Text);
if txtAddress.Text <> '' then
etyUser.SetAttributeValue(FD_ADDRESS, txtAddress.Text);
if txtAge.Text <> '' then
etyUser.SetAttributeValue(FD_AGE, StrToInt(txtAge.Text));

m_CtrSample.InsertEntity(@etyUser);

//refresh
cmdQueryAllClick(Sender);
end;

这是查询数据的方法，没有设置查询条件
//-----------------------------------------------------------------------------
// Query Entity
//-----------------------------------------------------------------------------
procedure TForm1.cmdQueryName1Click(Sender: TObject);
var
etyUser : IEntity;
begin
//get user name condition
if txtUserName.Text = '' then
begin
Application.MessageBox('please select one row', 'Error');
exit;
end;

//query
etyUser := TEtyUser.Create;

//这里没有条件参数, 所以必须给etyUser的PK赋值
etyUser.SetAttributeValue(FD_USER_NAME, txtUserName.Text);
m_CtrSample.LoadEntity(@etyUser);

//clear first
cmdClearClick(Sender);

//display user infromation
gdUser.Cells[1, 1] := etyUser.GetAttributeValue(FD_USER_NAME);
gdUser.Cells[2, 1] := etyUser.GetAttributeValue(FD_ADDRESS);
gdUser.Cells[3, 1] := IntToStr(etyUser.GetAttributeValue(FD_AGE));

//add it to list
m_listUser.AddEntity(etyUser);
end;

这是查询数据的方法，设置了查询条件

procedure TForm1.cmdQueryName2Click(Sender: TObject);
var
etyCondition : TEtyCondition;
listCondition : TEtyList;
etyUser : IEntity;
begin
//get user name condition
if txtUserName.Text = '' then
begin
Application.MessageBox('please select one row', 'Error');
exit;
end;

etyCondition := TEtyCondition.Create;
//这里FD_USER_NAME的值是EtyUser.xml文件的<EntityFieldName>
etyCondition.SetAttributeValue(FD_ENTITY_FIELD_NAME, FD_USER_NAME);
etyCondition.SetAttributeValue(FD_OPERATION, '=');
etyCondition.SetAttributeValue(FD_VALUE, txtUserName.Text);

listCondition := TEtyList.Create(TEtyCondition.Create);
listCondition.AddEntity(etyCondition);

//query
etyUser := TEtyUser.Create;
m_CtrSample.LoadEntity(@etyUser, listCondition);

//clear first
cmdClearClick(Sender);

//display user infromation
gdUser.Cells[1, 1] := etyUser.GetAttributeValue(FD_USER_NAME);
gdUser.Cells[2, 1] := etyUser.GetAttributeValue(FD_ADDRESS);
gdUser.Cells[3, 1] := IntToStr(etyUser.GetAttributeValue(FD_AGE));

//add it to list
m_listUser.AddEntity(etyUser);
end;

天啊！好多看不懂啊！