unitbasetable.pas

简单封装数据库表的类的一个简单的例子： http://www.delphifans.com/SoftView/SoftView_1476.html

unit UnitBaseTable;

//{$I MyUtils.inc}

interface

uses
  SysUtils, Windows, Messages, Classes, Contnrs, TypInfo,
  {$ifdef CodeSite}
  CSIntf,
  {$endif}  // CodeSite
  DB, Variants,
  MyUtils;

type

  TTableData = class;
  TTableDataClass = class of TTableData;
  TReferenced = class;
  TTableClassArray = array of TTableDataClass;

  TReferenceItem = class(TComponent)
  private
    FItemType: TTableDataClass;
    FReferenceColName: string;
  public
    constructor Create(AOwner: TComponent; AItemType: TTableDataClass;
            AReferenceColName: string); reintroduce;
    property ItemType: TTableDataClass read FItemType;
    property ReferenceColName: string read FReferenceColName;
  end;
  
  TReferenced = class(TObjectList)
  private
    function GetItem(Index: Integer): TReferenceItem;
    procedure SetItem(Index: Integer; const Value: TReferenceItem);
  public
    function Add(AOwner: TComponent; AItemType: TTableDataClass;
            AReferenceColName: string): TReferenceItem;
    property Items[Index: Integer]: TReferenceItem read GetItem write SetItem;
            default;
  end;
  
  TTableData = class(TComponent)
  private
    FDeleteFlag: Boolean;
    FFieldList: TStrings;
    FIsNew: Boolean;
    FModified: Boolean;
    FUniqueID: string;
    function GetFieldType(AName: string): Pointer;
    function GetValues(Name: string): Variant;
    procedure LoadFieldList;
    procedure SetValues(Name: string; Value: Variant);
  protected
    FReferenced: TReferenced;
    function GetModified: Boolean; virtual;
    procedure UpdateData; virtual;
    procedure UpdateReferenced; virtual;
  public
    constructor Create(AOwner: TComponent); overload; virtual;
    constructor Create(AOwner: TComponent; AData: TDataSet); reintroduce;
            overload;
    constructor CreateNew(AOwner: TComponent); virtual;
    destructor Destroy; override;
    class function AutoKeyValue: Boolean; virtual;
    procedure DoAfterDelete(Sender: TComponent); virtual;
    procedure DoAfterSave(Sender: TComponent); virtual;
    procedure DoBeforeDelete(Sender: TComponent); virtual;
    procedure DoBeforeSave(Sender: TComponent); virtual;
    function FieldExists(AName: string): Boolean;
    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;
    class function KeyColumnName: string; virtual;
    function KeyValue: Variant;
    class function OrderByList: string; virtual;
    class function PropertyExists(AName: string): Boolean;
    class function TableName: string; virtual;
    procedure UpdateValues(ASource: TDataSet);
    class function UseUniqueID: Boolean; virtual;
    property DeleteFlag: Boolean read FDeleteFlag write FDeleteFlag;
    property FieldList: TStrings read FFieldList;
    property IsNew: Boolean read FIsNew write FIsNew;
    property Modified: Boolean read GetModified write FModified;
    property Values[Name: string]: Variant read GetValues write SetValues;
  published
    property UniqueID: string read FUniqueID write FUniqueID;
  end;
  
  TTableDataList = class(TComponent)
  private
    FItemType: TTableDataClass;
    FList: TObjectList;
    FOnRefresh: TNotifyEvent;
    function GetCount: Integer;
    function GetModified: Boolean;
  protected
    function GetItem(Index: Integer): TTableData; virtual;
    procedure SetItem(Index: Integer; Value: TTableData); virtual;
  public
    constructor Create(AOwner: TComponent; AItemType: TTableDataClass);
            reintroduce;
    destructor Destroy; override;
    procedure Add(AValue: TTableData);
    procedure Append(ASource: TTableDataList);
    function AddFromDataSet(ASource: TDataSet): Integer;
    procedure Clear;
    function Extract(AObject: TTableData): TTableData;
    function FindByKeyValue(AOperator: TComponent; Value: Variant): TTableData;
            overload;
    function FindByKeyValue(Value: Variant): TTableData; overload;
    function FindByPropertyValue(APropertyName: string; AValue: Variant):
            TTableData;
    procedure Refresh; virtual;
    procedure Remove(AObject: TTableData);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TTableData read GetItem write SetItem;
            default;
    property ItemType: TTableDataClass read FItemType write FItemType;
    property Modified: Boolean read GetModified;
    property OnRefresh: TNotifyEvent read FOnRefresh write FOnRefresh;
  end;
  

const
  COL_UNIQUEID  = 'UniqueID';

implementation

uses
  unitDataOperator;

{ TBaseTable }

{
********************************** TTableData **********************************
}
constructor TTableData.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFieldList := TStringList.Create;
  FReferenced := TReferenced.Create;
  UpdateReferenced;
  LoadFieldList;
end;

constructor TTableData.Create(AOwner: TComponent; AData: TDataSet);
begin
  Create(AOwner);
  UpdateValues(AData);
  UpdateData;
end;

constructor TTableData.CreateNew(AOwner: TComponent);
begin
  Create(AOwner);
  FIsNew := True;
  //  {$ifdef USE_UNIQUEID}
  if UseUniqueID then
    FUniqueID := GetNewGUID;
  //  {$endif}  // USE_UNIQUEID
end;

destructor TTableData.Destroy;
begin
  FFieldList.Free;
  FReferenced.Free;
  inherited Destroy;
end;

class function TTableData.AutoKeyValue: Boolean;
begin
  //  {$ifdef Use_UniqueID}
  if UseUniqueID then
    result := not SameText(KeyColumnName, COL_UNIQUEID)
  else
    result := True;
  //  {$endif}  // Use_UniqueID
end;

procedure TTableData.DoAfterDelete(Sender: TComponent);
begin
end;

procedure TTableData.DoAfterSave(Sender: TComponent);
begin
end;

procedure TTableData.DoBeforeDelete(Sender: TComponent);
var
  I, J: Integer;
  fOperator: TDataOperator;
  fList: TTableDataList;
begin
  if not (Sender is TDataOperator) then Exit;
  fOperator := Sender as TDataOperator;
  for I := 0 to FReferenced.Count - 1 do    // Iterate
  begin
    fList := TTableDataList.Create(Self, FReferenced[I].ItemType);
    try
      if fOperator.LoadItems(fList, [FReferenced[I].ReferenceColName],
        [KeyValue]) > 0 then
      begin
        for J := 0 to fList.Count - 1 do    // Iterate
        begin
          fOperator.Delete(fList[J]);
        end;    // for
      end;
    finally
      fList.Free;
    end;
  end;    // for
end;

procedure TTableData.DoBeforeSave(Sender: TComponent);
begin
end;

function TTableData.FieldExists(AName: string): Boolean;
begin
  result := FieldList.IndexOf(AName) > -1;
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;

function TTableData.GetFieldType(AName: string): Pointer;
begin
  result := PPropInfo(FFieldList.Objects[FFieldList.IndexOf(AName)])^.PropType^;
end;

function TTableData.GetModified: Boolean;
begin
  Result := FModified;
end;

function TTableData.GetValues(Name: string): Variant;
begin
  result := GetPropValue(Self, Name, False);
end;

class function TTableData.KeyColumnName: string;
begin
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;
  //      {$ifdef CodeSite}
  //      CodeSite.SendFmtMsg('%s.Type=%s', [PropName, PropList[I]^.PropType^.Name ]);
  //      {$endif}  // CodeSite
  
      if SameText(PropName, 'Tag') then Continue;
      if SameText(PropList[I]^.PropType^.Name, 'TComponentName') then Continue;
  
      FFieldList.AddObject(PropName, TObject(PropList[I]));
    end;
  finally
      // free resources
    FreeMem(PropList);
  end;  // try/finally
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