gsentitydataset.pas

用Delphi实现的数据库持久化

unit gsEntityDataSet;
(******************************************************************
                   强类型数据集实现
                   
  用RTTI实现的数据集代理，可以简单地将数据集对象化。
  Copyright (c) 2006 by 碧水航工作室.
  Author : TinTin
  Date   : 2006.07.10 （世界杯决赛前夕）

  参考代码：1.猛禽兄 <<用DELPHI的RTTI实现数据集的简单对象化>>
              详见猛禽兄的Blog
              http://borland.mblogger.cn/raptor/posts/14782.aspx

            2.Chris Lichti的delphi之 RTTI管理类，单元clRTTI就是
              他所写，我保留了他的原著，也不再注释成中文了

  参悟代码：3.我同事（绰号：大师）一个 .NET SuperORM 框架思想
              详见大师的个人学习网站
              http://www.wbstudy.com/

            在此对他们表示由衷的感谢!!!       
  扩展说明：在理解猛禽兄的源码上，重写了实体数据集体对象化。
            扩展了实体的遍历、新增、修改和删除，即常用的CURD功能。
            如同猛禽兄所说的，要获得属性名称，只好利用属性索引，即index 0
            我暂时没有别的办法。为了保证实体类成员与数据集字段序号一一对应，
            我特地做了强制检验，方法 CheckEntityDataSet。
            property Name: TStringF index 0 read GetStringF;
            property Area: TNumberF index 3 read GetNumberF;
            但是，如果一个在后期管理实体类，我想完全可以避免属性索引的尴尬。

            我现在步入 .NET项目开发，如果有时间，我会扩展一下功能：
            客户端：
            1、客户端无SQL，只是传递参数值。参数最好以强类型赋值。
            2、客户端的据集对象化，即实现简单的ORM功能。
            3、扩展现有的客户端的据集对象化，实现查询数据集体对象化。
               我还要仔细参悟大师的 SuperORM，delphi的RTTI没有.NET的反射机制强大，
               很是苦恼。
               
            4、所有的TdataSet的中文标题通过数据库表自动填充实现，包括数据集字段的
              一些属性，比如 format格式，对其方式、默认值等。

            5、实体类的Lookup自动化，其实现原理获得所有表与表之间的关系，自动
               实现数据集的Lookup，不需人工干预，使 Coding工作更高效，脱离码奴思想。
            6、一些常用的数据库界面控件封装。现在采用 Ehlib套件和 DevExpress的垂直表格控件。
               快速获得最强大最方便的前台功能界面。
            7、实体类也可以实现可视化界面设计，比如再 TDataModule放置
               TDataSource， TAdoConnection ,TAdoQuery之类，如果需要可视化处理
               DataField和表格列宽，录入 SQL到 TAdoQuery。
               与此类推应用到BDE,DbExpress。切换时候不要忘记无用的Uses单元名称。
            8、一个通用强大的查询对话框。可实现复杂的多表连接查询。
              
            服务端：
            1、服务端的AOP，即面向功能或面向服务。所有的方法或函数放在服务端上，
               且方法或函数为无参数形式，其内部参数通过对应的客户端输入参数获得。
               服务端以动态组合方法或函数的方式执行任务。支持事务机制。
            2、客户端打开数据集或执行任务完毕，关闭数据库连接，节省资源。
            3、具体数据集无关性。即封装TdataSet或 TClientDataSet，即切换ADO或
               或BDE或DbExpress，将修改工作量减到最少。
            4、实现了界面与业务功能代码分离以后，再将改为三层结构，就容易多了。
               你说是不是呢？

  在
******************************************************************)
interface
uses
  SysUtils, Classes, DB, TypInfo, Contnrs, Variants, gsEntityField, clRTTI;
type
  //TgsLookupProxy = procedure (Sender:TObject;Index:Integer);
  TgsDataSetProxy = class(TPersistent)
  private
    FKeyIndex:Integer;
    FPropCount: Integer;
    FPropList: PPropList; //属性指针列表
    //数据集成员
    FDataSet: TDataSet;
    //循环标记
    FLooping: Boolean;
    FFieldList: TObjectList; //保存实体字段类型
    FEditState: Boolean; //新增或修改状态
    FRTTI: TrtWrapper; //请注意 TrtWrapper  的ObjPropList与 FPropList顺序不一致，
    function GetPropName(Index: Integer): ShortString;
    function GetKeyName: string;
    function GetPropCount: Integer;
    function GetPropTypes(Index: Integer): string;
  protected
    function GetProp(Index: Integer): PPropInfo;
    procedure BeginEdit;
    procedure EndEdit;
    //读取字段类
    function GetIntF(Index: Integer): TIntF; virtual;
    function GetNumberF(Index: Integer): TNumberF; virtual;
    function GetStringF(Index: Integer): TStringF; overload; virtual;
    function GetVarF(Index: Integer): TVarF; virtual;
    //校验属性与数据集是否一致
    function CheckEntityDataSet: Boolean;
  public
    //统一接口，只暴露 TDataSource
    DataSource: TDataSource;
    //初始化构造
    constructor Create(aDataSet: TDataSet;KeyIndex:Integer=0);
    destructor Destroy; override;
    procedure AfterConstruction; override;

    //指定属性名是否存在
    function HasProperty(PropertyName: string): boolean;
    //获得属性成员 Tobject
    function GetPropObj(Index: Integer): TObject; overload;
    function GetPropObj(PropName: string): TObject; overload;
    //获得属性成员值
    //function GetPropValue(aIndex: Integer):Variant;

    //*********数据集操作*********************
    function ForEach: Boolean; //遍历
    procedure First;
    function Next: Boolean;
    function Prior: Boolean;
    procedure Last;
    //定位
    function Locate(Value: Variant): Boolean; overload;
    function Locate(EntityField: TgsPropField): Boolean; overload;
    //*****************属性设置**************************
    //属性数量
    property PropCount: Integer read GetPropCount;
    //属性名
    property PropNames[aIndex: Integer]: ShortString read GetPropName;
    //属性信息数组
    property Props[Index: Integer]: PPropInfo read GetProp;
    //获得属性类型
    property PropTypes[Index: Integer]: string read GetPropTypes;
    //关键字段
    property KeyName: string read GetKeyName;

    //*****************实体类的CURD****************************
    //获得 TgsPropField值
    function CheckedEditState:Boolean;
    function GetPropFieldValue(PropField: TgsPropField): Variant;
    //Included 为 True，表示 新增参数实体字段，为false，除去这些参数实体字段，其余都新增
    procedure Insert(EntityFields: array of TgsPropField; Included: Boolean); overload;
    //实体的全部成员插入数据库
    procedure Insert; overload;
    //修改实体内容
    procedure Update(EntityFields: array of TgsPropField; EntityKey: TgsPropField; Included: Boolean); overload;
    //修改全部实体内容
    procedure Update(EntityKey: TgsPropField); overload;
    //删除实体   删除成功返回 true，否则为false
    function Delete(EntityKey: TgsPropField): Boolean;overload;
    function Delete(KeyValue: Variant): Boolean; overload;
  published

  end;
implementation
uses forms,Controls;
{ TgsDataSetProxy }

procedure TgsDataSetProxy.AfterConstruction;
var
  i: Integer;
begin
  inherited;
  //校验实体与数据集对应关系
  if not CheckEntityDataSet then
    raise Exception.Create('实体与数据集对应关系不一致!   ');
  FFieldList.Clear;

  for i := 0 to FPropCount - 1 do
  begin
    if GetPropTypes(i) = 'TIntF' then
      FFieldList.Add(TIntF.Create)
    else if GetPropTypes(i) = 'TNumberF' then
      FFieldList.Add(TNumberF.Create)
    else if GetPropTypes(i) = 'TStringF' then
      FFieldList.Add(TStringF.Create)
    else if GetPropTypes(i) = 'TBooleanF' then
      FFieldList.Add(TBooleanF.Create)
  end;
end;


procedure TgsDataSetProxy.BeginEdit;
begin
  FEditState := True;
end;

function TgsDataSetProxy.CheckedEditState:Boolean;
begin
  Result := False;
  if not FEditState then
  begin
    raise Exception.Create('新增、修改或删除记录请先调用BeginEdit方法');
  end;
  Result := True;
end;

function TgsDataSetProxy.CheckEntityDataSet: Boolean;
var
  i: Integer;
begin
  Result := True;
  if FDataSet.FieldCount = 0 then
  begin
    Result := False;
    Exit;
  end;
  //  raise Exception.Create('数据集字段为空，不能校验!   ');
  for i := 0 to PropCount - 1 do
  begin
    if FDataSet.FindField(PropNames[i]) = nil then
    begin
      Result := False;
      //raise Exception.Create('数据集字段为空，不能校验!   ');
      Break;
    end;
  end;
end;

constructor TgsDataSetProxy.Create(aDataSet: TDataSet;KeyIndex:Integer);
begin
  inherited Create;
  //属性树
  FKeyIndex := KeyIndex;
  FPropCount := GetTypeData(Self.ClassInfo)^.PropCount;
  FPropList := nil;
  if FPropCount > 0 then
  begin
    //分配内存
    GetMem(FPropList, FPropCount * SizeOf(Pointer));
    GetPropInfos(Self.ClassInfo, FPropList);
  end;

  FDataSet := aDataSet;
  FDataSet.Open;
  DataSource := TDataSource.Create(nil);
  DataSource.DataSet := aDataSet;

  FLooping := false;
  FFieldList := TObjectList.Create(True);
  //创建实体类的RTTI类
  FRTTI := TrtWrapper.Create(Self);
end;

function TgsDataSetProxy.Delete(EntityKey: TgsPropField): Boolean;
begin
  Result := False;
  //判断编辑状态
  CheckedEditState;
  if not Locate(EntityKey) then
    Exit;
  try
    try
      FDataSet.Delete;
      Result := True;
    except
      on e: Exception do
      begin
        e.Create('修改记录失败！   ' + cstWrap + e.Message);
      end;
    end;
  finally
    EndEdit;
  end;
end;

function TgsDataSetProxy.Delete(KeyValue: Variant): Boolean;
begin
  Result := False;
  //判断编辑状态
  CheckedEditState;
  if not Locate(KeyValue) then
    Exit;
  try
    try
      FDataSet.Delete;
      Result := True;
    except
      on e: Exception do
      begin
        e.Create('修改记录失败！   ' + cstWrap + e.Message);
      end;
    end;
  finally
    EndEdit;
  end;
end;

destructor TgsDataSetProxy.Destroy;
begin
  FFieldList.Free;
  FRTTI.Free;
  DataSource.Free;
  if Assigned(FPropList) then
    FreeMem(FPropList);
  inherited;
end;

procedure TgsDataSetProxy.EndEdit;
begin
  FEditState := False;
end;

procedure TgsDataSetProxy.First;
begin
  FDataSet.First;
end;

function TgsDataSetProxy.ForEach: Boolean;
begin
  try
    Result := not FDataSet.Eof;
    if FLooping then
    begin
      EndEdit;
      FDataSet.Next;
      Result := not FDataSet.Eof;
      if not Result then
      begin
        //FDataSet.First;
        FLooping := false;
        FDataSet.EnableControls;
        Screen.Cursor := crDefault;
      end;
    end
    else if Result then
    begin
      Screen.Cursor := crHourGlass;
      FLooping := true;
      FDataSet.DisableControls; //提高遍历效率，估计有三倍左右
    end;
  except
    //异常保护
    FLooping := false;
    FDataSet.EnableControls;
    Screen.Cursor := crDefault;
  end;
end;

function TgsDataSetProxy.GetIntF(Index: Integer): TIntF;
begin
  Result := TIntF(FFieldList.Items[Index]);
  Result.Name := PropNames[Index];
  if not FEditState then
  begin
    Result.Caption := FDataSet.FieldByName(PropNames[Index]).DisplayLabel;
    Result.AsInt := FDataSet.FieldByName(PropNames[Index]).AsInteger;
  end;
end;

function TgsDataSetProxy.GetKeyName: string;
begin
  Result := GetProp(FKeyIndex)^.Name;
end;

function TgsDataSetProxy.GetNumberF(Index: Integer): TNumberF;
begin
  Result := TNumberF(FFieldList.Items[Index]);
  Result.Name := PropNames[Index];
  if not FEditState then
  begin
    Result.Caption := FDataSet.FieldByName(PropNames[Index]).DisplayLabel;
    Result.AsNum := FDataSet.FieldByName(PropNames[Index]).AsFloat;
  end;
end;

function TgsDataSetProxy.GetProp(Index: Integer): PPropInfo;
begin
  Result := nil;
  if (Assigned(FPropList)) then
    Result := FPropList[Index];
end;