dbgw.pas

数据库封装原代码 1. 该代码可以免费使用, 该代码的名字暂时定为"哲别" 2. 如果你需要使用该代码, 请注明该代码的原来作者: Jacky Zhou 3. 如果你发现该代码有bug,可以自己修改

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[i].FieldName;
      strFieldType := GetTableFieldType(strTableName, strFieldName);
      varFieldValue := FormatValueDBToApp(connection.Fields[i].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[i].FieldName;
        strFieldType := GetTableFieldType(strTableName, strFieldName);
        varFieldValue := FormatValueDBToApp(connection.Fields[i].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;