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;
子类必须覆盖这些类函数。