Delphi和C++ Builder中的Hibernate开发（二）

在Hibernate中有PO对象和POJO对象，

POJO = pure old java object or plain ordinary java object or what ever.

PO = persisent object 持久对象

就是说在一些Object/Relation Mapping工具中，能够做到维护数据库表记录的persisent object完全是一个符合Java Bean规范的纯Java对象，没有增加别的属性和方法。

持久对象实际上必须对应数据库中的entity，以如下数据库QQGroup为例，其中有5张表，Member为成员表，一个成员具有成果Researchs，也可能受到警告Warnings。

CREATE DATABASE [QQGroup]
GO
 
USE [QQGroup]
GO
 
CREATE TABLE [Constants] (
	[Code] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[Name] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	 PRIMARY KEY  CLUSTERED 
	(
		[Code]
	)  ON [PRIMARY] 
) ON [PRIMARY]
GO
 
CREATE TABLE [Idg] (
	[CODE] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[NAME] [varchar] (20) COLLATE Chinese_PRC_CI_AS NULL ,
	 PRIMARY KEY  CLUSTERED 
	(
		[CODE]
	)  ON [PRIMARY] 
) ON [PRIMARY]
GO
 
CREATE TABLE [Members] (
	[QQCode] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[UserName] [varchar] (32) COLLATE Chinese_PRC_CI_AS NULL ,
	[Sex] [char] (1) COLLATE Chinese_PRC_CI_AS NULL ,
	[Age] [varchar] (10) COLLATE Chinese_PRC_CI_AS NULL ,
	[Area] [varchar] (100) COLLATE Chinese_PRC_CI_AS NULL ,
	[NameCard] [varchar] (32) COLLATE Chinese_PRC_CI_AS NULL ,
	[Email] [varchar] (200) COLLATE Chinese_PRC_CI_AS NULL ,
	[WebSite] [varchar] (200) COLLATE Chinese_PRC_CI_AS NULL ,
	[Research] [ntext] COLLATE Chinese_PRC_CI_AS NULL ,
	[Status] [varchar] (12) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[OutReason] [ntext] COLLATE Chinese_PRC_CI_AS NULL ,
	[InTime] [datetime] NULL ,
	[OutTime] [datetime] NULL ,
	[Identity1] [varchar] (12) COLLATE Chinese_PRC_CI_AS NULL ,
	[GotWarn] [char] (1) COLLATE Chinese_PRC_CI_AS NULL ,
	[GotResearch] [char] (1) COLLATE Chinese_PRC_CI_AS NULL ,
	CONSTRAINT [PK__Members__76CBA758] PRIMARY KEY  CLUSTERED 
	(
		[QQCode]
	)  ON [PRIMARY] 
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO
 
CREATE TABLE [Researchs] (
	[SelfId] [varchar] (18) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[QQCode] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[Time] [datetime] NULL ,
	[Context] [ntext] COLLATE Chinese_PRC_CI_AS NULL ,
	 PRIMARY KEY  CLUSTERED 
	(
		[SelfId]
	)  ON [PRIMARY] 
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO
 
CREATE TABLE [Warnings] (
	[SelfId] [varchar] (18) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[QQCode] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
	[WarnTime] [datetime] NOT NULL ,
	[Reason] [ntext] COLLATE Chinese_PRC_CI_AS NULL ,
	 PRIMARY KEY  CLUSTERED 
	(
		[SelfId]
	)  ON [PRIMARY] 
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO
 
INSERT INTO [Constants] VALUES('M', '男')
INSERT INTO [Constants] VALUES('F', '女')
INSERT INTO [Constants] VALUES('In', '在群')
INSERT INTO [Constants] VALUES('Out', '已退群')
INSERT INTO [Constants] VALUES('Admin', '管理员')
INSERT INTO [Constants] VALUES('Member', '会员')
INSERT INTO [Constants] VALUES('Y', '是')
INSERT INTO [Constants] VALUES('N', '否')

 

在Delphi或C++ Builder中，我们可以定义表Members对应的持久对象TMembers为：

(* This unit is created by My PODO generator *)
 
unit PODO_MEMBERS;
 
{$M+}
 
interface
 
uses
  Classes, SysUtils, UnitBaseTable;
 
type
  TMembers = class(TTableData)
  private
    FQQCode: String;
    FUserName: String;
    FSex: String;
    FAge: String;
    FArea: String;
    FNameCard: String;
    FEmail: String;
    FWebSite: String;
    FResearch: Variant;
    FStatus: String;
    FOutReason: Variant;
    FInTime: TDateTime;
    FOutTime: TDateTime;
    FIdentity1: String;
    FGotResearch: String;
    FGotWarn: String;
  published
    property QQCode: String read FQQCode write FQQCode;
    property UserName: String read FUserName write FUserName;
    property Sex: String read FSex write FSex;
    property Age: String read FAge write FAge;
    property Area: String read FArea write FArea;
    property NameCard: String read FNameCard write FNameCard;
    property Email: String read FEmail write FEmail;
    property WebSite: String read FWebSite write FWebSite;
    property Research: Variant read FResearch write FResearch;
    property Status: String read FStatus write FStatus;
    property OutReason: Variant read FOutReason write FOutReason;
    property InTime: TDateTime read FInTime write FInTime;
    property OutTime: TDateTime read FOutTime write FOutTime;
    property Identity1: String read FIdentity write FIdentity;
    property GotWarn: String read FGotWarn write FGotWarn;
    property GotResearch: String read FGotResearch write FGotResearch;
  public
     　 class
    function KeyColumnName: string;
    override;
     　 class
    function TableName: string;
    override;
  end;
 
implementation
 
{ TMembers }
 
class function TMembers.KeyColumnName: string;
begin
   result := 'QQCode';
end;
 
class function TMembers.TableName: string;
begin
   result := 'Members';
end;
 
initialization
 
RegisterClass(TMembers);
 
end.

  从代码中可以看到TMembers类的定义的属性与表Members中的字段一一对应。

  所有的持久类继承自TTableData, TTableData的定义很关键，它是所有持久类的基类。如要新加一个子类，只需从TTableData类继承，然后在Published里申明相应的属性，属性名称与字段需要相同。同时为了对象内存管理方便，TTableData类从TPersistent继承，可以减少内存泄漏的可能性。VCL 的基类 TObject 本身不支持 RTTI（运行时类型信息），TPersistent 类通过 { $M+ } 编译指令提供了 RTTI（运行时类型信息） 的功能，打开了 M 开关后，Delphi 在编译该对象时，会把对象的类型信息也编译进可执行文件，这样在运行时就可以动态的获得对象的属性，方法等信息，所有的 VCL 可视化组件都是从 TPersistent 派生出来的，因此可以将组件信息保存成 DFM 文件，可以在运行时加载。

    那么如何实现一般对象的持久化(Persistent)呢, 解决方案如下:

unit UnitBaseTable;
 
// {$I MyUtils.inc}
 
interface
 
uses
  SysUtils, Windows, Messages, Classes, Contnrs, TypInfo,
  DB, Variants,
  MyUtils;
 
type
 
  TTableData = class;
  TTableDataClass = class of TTableData;
  TTableClassArray = array of TTableDataClass;
 
  TTableData = class(TPersistent)
  private
    FFieldList: TStrings;
    FIsNew: Boolean;
    FModified: Boolean;
    FUniqueID: string;
    FDeleteFlag: Boolean;
    FGenerator: String;
    function GetFieldType(AName: string): Pointer;
    function GetValues(Name: string): Variant;
    procedure LoadFieldList;
    procedure SetValues(Name: string; Value: Variant);
    class function GetKeyValueWhere: string;
  protected
    procedure UpdateData; virtual;
  public
    constructor Create(); reintroduce; overload;
    constructor Create(AData: TDataSet); reintroduce; overload;
    constructor CreateNew(); virtual;
    destructor Destroy; override;
 
    // 判断字段类型
    function FieldIsBoolean(AName: string): Boolean;
    function FieldIsDateTime(AName: string): Boolean;
    function FieldIsFloat(AName: string): Boolean;
    function FieldIsInteger(AName: string): Boolean;
    function FieldIsString(AName: string): Boolean;
 
    // 字段是否存在
    function FieldExists(AName: string): Boolean;
 
    // 主键字段值
    function KeyValue: Variant;
    procedure UpdateValues(ASource: TDataSet);
 
    class function AutoKeyValue: Boolean; virtual;
    class function KeyColumnName: string; virtual;
    class function TableName: string; virtual;
    class function GeneratorType: string; virtual;
 
    // 是否使用主键PrimaryKey
    class function UseUniqueID: Boolean; virtual;
 
    class function OrderByList: string; virtual;
 
    class function PropertyExists(AName: string): Boolean;
 
    property FieldList: TStrings read FFieldList;
    property IsNew: Boolean read FIsNew write FIsNew;
    property Modified: Boolean read FModified write FModified;
    property Values[Name: string]: Variant read GetValues write SetValues;
    property DeleteFlag: Boolean read FDeleteFlag write FDeleteFlag;
    property UniqueID: string read FUniqueID write FUniqueID;
    property Generator: string read FGenerator write FGenerator;
  published
    //
  end;
 
const
  COL_UNIQUEID = 'UniqueID';
 
implementation
 
uses
  unitDataOperator;
 
{ TBaseTable }
 
{
  ********************************** TTableData **********************************
}
constructor TTableData.Create();
begin
  inherited Create();
  FFieldList := TStringList.Create;
  LoadFieldList;
end;
 
constructor TTableData.Create(AData: TDataSet);
begin
  UpdateValues(AData);
  UpdateData;
end;
 
constructor TTableData.CreateNew();
begin
  FIsNew := True;
  // {$ifdef USE_UNIQUEID}
  // if UseUniqueID then
  // FUniqueID := GetNewGUID;          //added by sunweijun
  // {$endif}  // USE_UNIQUEID
end;
 
destructor TTableData.Destroy;
begin
  FFieldList.Free;
  inherited Destroy;
end;
 
class function TTableData.AutoKeyValue: Boolean;
begin
  // {$ifdef Use_UniqueID}
  Result := False;
  if UseUniqueID then
    Result := (GeneratorType = 'increment') or (GeneratorType = 'native') or
      (GeneratorType = 'identity');
  // {$endif}  // Use_UniqueID
end;
 
function TTableData.FieldIsBoolean(AName: string): Boolean;
begin
  Result := GetFieldType(AName) = TypeInfo(Boolean);
end;
 
function TTableData.FieldIsDateTime(AName: string): Boolean;
begin
  Result := GetFieldType(AName) = TypeInfo(TDateTime);
end;
 
function TTableData.FieldIsFloat(AName: string): Boolean;
begin
  Result := GetFieldType(AName) = TypeInfo(Real);
end;
 
function TTableData.FieldIsInteger(AName: string): Boolean;
begin
  Result := GetFieldType(AName) = TypeInfo(Integer);
end;
 
function TTableData.FieldIsString(AName: string): Boolean;
begin
  Result := GetFieldType(AName) = TypeInfo(String);
end;
 
class function TTableData.GeneratorType: string;
begin
  Result := 'assigned';
end;
 
function TTableData.GetFieldType(AName: string): Pointer;
begin
  Result := PPropInfo(FFieldList.Objects[FFieldList.IndexOf(AName)])^.PropType^;
end;
 
function TTableData.GetValues(Name: string): Variant;
begin
  Result := GetPropValue(Self, Name, False);
end;
 
class function TTableData.KeyColumnName: string;
begin
  Result := EmptyStr;
end;
 
function TTableData.KeyValue: Variant;
begin
  if KeyColumnName <> EmptyStr then
    Result := GetValues(KeyColumnName);
end;
 
procedure TTableData.LoadFieldList;
var
  PropCount, I: SmallInt;
  PropList: PPropList;
  PropName: string;
begin
  PropCount := GetTypeData(ClassInfo).PropCount;
  GetPropList(ClassInfo, PropList);
  try
    for I := 0 to PropCount - 1 do
    begin
      PropName := PropList[I]^.Name;
 
      FFieldList.AddObject(PropName, TObject(PropList[I]));
    end;
  finally
    // free resources
    FreeMem(PropList);
  end; // try/finally
end;
 
procedure TTableData.SetValues(Name: string; Value: Variant);
begin
  if not VarIsNull(Value) then
    SetpropValue(Self, Name, Value);
end;
 
class function TTableData.TableName: string;
begin
  Result := EmptyStr;
end;
 
procedure TTableData.UpdateData;
begin
end;
 
procedure TTableData.UpdateValues(ASource: TDataSet);
var
  I: Integer;
  fName: string;
  fValue: Variant;
begin
  if ASource = nil then
    Exit;
 
  if not ASource.Active then
    ASource.Open;
  if ASource.Eof then
    raise Exception.CreateFmt('%s.UpdateValues: Not found data', [ClassName]);
  for I := 0 to ASource.FieldCount - 1 do // Iterate
  begin
    try
      fName := ASource.Fields[I].DisplayName;
      fValue := ASource.Fields[I].Value;
      if UseUniqueID and SameText(fName, COL_UNIQUEID) and VarIsNull(fValue)
      then
        // fValue := GetNewGUID;   //added by sunweijun
        // {$endif}  // Use_UniqueID
 
        if FFieldList.IndexOf(fName) > -1 then
        begin
          SetValues(fName, fValue);
        end;
    except
      on e: Exception do
      begin
        raise;
      end;
    end; // try/except
  end; // for
end;
 
class function TTableData.UseUniqueID: Boolean;
begin
  Result := False;
end;
 
class function TTableData.OrderByList: string;
begin
  Result := EmptyStr;
end;
 
class function TTableData.PropertyExists(AName: string): Boolean;
var
  FPropInfo: PPropInfo;
begin
  FPropInfo := GetpropInfo(ClassInfo, AName);
  Result := FPropInfo <> nil;
  // if result then
  // FreeMem(FPropInfo);
end;
 
function TTableData.FieldExists(AName: string): Boolean;
begin
  Result := FieldList.IndexOf(AName) > -1;
end;
 
class function TTableData.GetKeyValueWhere: string;
begin
  Result := KeyColumnName + ' = :' + KeyColumnName;
end;
 
end.

 

     本框架的设计不采用XML配置文件，因此在持久类的定义中要包含一些配置信息，类似于Java Hibernate里的注解功能。此处定义了两个类函数，KeyColumnName和TableName,分别返回关键字段名和表名。

　　（1）返回表的关键列名：
　　class function KeyColumnName: string; virtual;
　　（2）返回表的名称：
　　class function TableName: string; virtual;
　　（3）表中的唯一字段是否使用GUID（默认不使用，如果不改的话可以不覆盖）：
　　 class function UseUniqueID: Boolean; virtual;

       子类必须覆盖这些类函数。