⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 s2.model.ts2serverdatamodel.pas

📁 轉載的程序應用框架
💻 PAS
字号:
unit S2.Model.TS2ServerDataModel;

interface

uses
  Classes, SysUtils, Types, S2.Model.TS2Model, S2.Model.IS2DataService, S2.Model.IS2BusinessObject,
  S2.Model.TS2DataModel, DB, DBClient, Provider, S2.Core.IS2SystemObject,
  S2.Model.IS2DatabaseConnection, S2.Tools.TS2Record, S2.Tools.TS2Field,
  S2.Model.TS2SystemObject, S2.Tools.TS2Object;

type
  TS2ServerDataModel = class(TS2DataModel, IS2BusinessObject, IS2DataService)
    _DataSource: TDataSource;
    _Provider: TDataSetProvider;
    _ClientDataSet: TClientDataSet;
  private
    _RefCount: Integer;
    _SystemObject: IS2SystemObject;
  private
    procedure DecRefCount;
    procedure IncRefCount;
  protected
    function GetConnection: IS2DatabaseConnection; virtual;
  public
    function CreateClientDataModel: TS2Model;
    procedure OpenByCondition(const Condition: string);
    procedure Save; virtual;
  public  //  S2.Model.IS2DataService
    function GetDataSet: TDataSet; override;
    function GetPrimaryKey: TS2Record; override;
    procedure BindingParameters(Data: TS2Field); overload; virtual;
    procedure BindingParameters(Data: TS2Record); overload; virtual;
  public
    constructor Create(SystemObject: TS2SystemObject); 
  protected
    function ToStringArray(const S1: string): TStringDynArray; overload;
    function ToStringArray(const S1, S2: string): TStringDynArray; overload;
    function ToStringArray(const S1, S2, S3: string): TStringDynArray; overload;
    function GetPrimaryKeyName: TStringDynArray; virtual;
  public
    procedure OpenModel(O: TS2Object); override;
    procedure Append(DataSet: TClientDataSet);
    procedure Delete(DataSet: TClientDataSet);
    procedure Modify(DataSet: TClientDataSet);
  private
    procedure AppendRecord(DataSet: TClientDataSet);
    procedure DeleteRecord(DataSet: TClientDataSet);
    procedure ModifyRecord(DataSet: TClientDataSet);
    procedure LoadData(DataSet: TDataSet); virtual;
    function GetSinglePrimaryKeyName: string;
  protected
    procedure OnAppendRecord(DataSet: TDataSet); virtual;
    procedure OnDeleteRecord(DataSet: TDataSet); virtual;
    procedure OnModifyRecord(DataSet: TDataSet); virtual;
  end;

  TS2ServerDataModelClass = class of TS2ServerDataModel;

implementation

uses
  Dialogs,
  S2.Model.TS2ClientDataModel, S2.Error.S2AbstractException, S2.Error.S2DataSetOpenException,
  S2.Error.S2ReadOnlyException, S2.Error.S2PrepareAppendException, S2.Error.S2PrepareCancelException,
  S2.Error.S2PrepareDeleteException, S2.Error.S2PrepareSaveException, S2.Error.S2DataAdapterException,
  S2.Error.S2DataSuncertaintyException, S2.Model.TS2AdapterClientDataModel, S2.Error.S2DataNotFound,
  S2.Error.S2Exception, S2.Model.TS2DatabaseManager;

{$R *.dfm}

{ TS2ServerDataModel }

procedure TS2ServerDataModel.BindingParameters(Data: TS2Record);
begin
  raise S2AbstractException.Create(ClassName, 'BindingParameters(Data: TS2Record)');
end;

procedure TS2ServerDataModel.BindingParameters(Data: TS2Field);
begin
  raise S2AbstractException.Create(ClassName, 'BindingParameters(Data: TS2Field)');
end;

constructor TS2ServerDataModel.Create(SystemObject: TS2SystemObject);
begin
  inherited Create(SystemObject);
  _SystemObject := SystemObject;
  InitModel;
end;

function TS2ServerDataModel.CreateClientDataModel: TS2Model;
begin
  if IsReadOnly then
    Result := TS2ClientDataModel.Create(Self)
  else
    Result := TS2AdapterClientDataModel.Create(Self);
end;

procedure TS2ServerDataModel.DecRefCount;
begin
  Dec(_RefCount);
end;

function TS2ServerDataModel.GetConnection: IS2DatabaseConnection;
begin
  Result := TS2DatabaseManager(GetGlobalSystemObject.GetDatabaseManager).GetConnection;
end;

function TS2ServerDataModel.GetDataSet: TDataSet;
begin
  Result := _ClientDataSet;
end;

function TS2ServerDataModel.GetPrimaryKey: TS2Record;
begin
  Result := GetDataByFieldName(GetPrimaryKeyName);
end;

function TS2ServerDataModel.GetPrimaryKeyName: TStringDynArray;
begin
  raise S2AbstractException.Create(ClassName, 'GetPrimaryKeyName');
end;

procedure TS2ServerDataModel.IncRefCount;
begin
  Inc(_RefCount);
end;

procedure TS2ServerDataModel.OpenByCondition(const Condition: string);
begin
end;

function TS2ServerDataModel.ToStringArray(const S1: string): TStringDynArray;
begin
  SetLength(Result, 1);
  Result[0] := S1;
end;

function TS2ServerDataModel.ToStringArray(const S1, S2: string): TStringDynArray;
begin
  SetLength(Result, 2);
  Result[0] := S1;
  Result[1] := S2;
end;

procedure TS2ServerDataModel.OpenModel(O: TS2Object);
begin
  inherited;
  GetDataSet.Open;
end;

function TS2ServerDataModel.ToStringArray(const S1, S2, S3: string): TStringDynArray;
begin
  SetLength(Result, 3);
  Result[0] := S1;
  Result[1] := S2;
  Result[2] := S3;
end;

procedure TS2ServerDataModel.Save;
begin
  raise S2AbstractException.Create(ClassName, 'Save');
end;

procedure TS2ServerDataModel.Append(DataSet: TClientDataSet);
begin
  try
    DataSet.First;
    while not DataSet.Eof do
    begin
      AppendRecord(DataSet);
      DataSet.Next;
    end;
  except
    on E: Exception do
    begin
      GetDataSet.Cancel;
      raise
    end;
  end;
end;

procedure TS2ServerDataModel.Delete(DataSet: TClientDataSet);
begin
  try
    DataSet.First;
    while not DataSet.Eof do
    begin
      DeleteRecord(DataSet);
      DataSet.Next;
    end;
  except
    on E: Exception do
    begin
      GetDataSet.Cancel;
      raise
    end;
  end;
end;

procedure TS2ServerDataModel.Modify(DataSet: TClientDataSet);
begin
  try
    DataSet.First;
    while not DataSet.Eof do
    begin
      ModifyRecord(DataSet);
      DataSet.Next;
    end;
  except
    on E: Exception do
    begin
      GetDataSet.Cancel;
      raise
    end;
  end;
end;

procedure TS2ServerDataModel.AppendRecord(DataSet: TClientDataSet);
begin
  GetDataSet.Append;
  LoadData(DataSet);
  OnAppendRecord(GetDataSet);
end;

procedure TS2ServerDataModel.DeleteRecord(DataSet: TClientDataSet);
var
  FieldName: String;
  Index: Integer;
begin
  FieldName := GetSinglePrimaryKeyName;
  if GetDataSet.Locate(FieldName, DataSet.FieldByName(FieldName).Value, []) then
  begin
    OnDeleteRecord(GetDataSet);
    GetDataSet.Delete;
  end
  else
    raise S2DataNotFound.Create(ClassName, 'DeleteRecord');
end;

procedure TS2ServerDataModel.ModifyRecord(DataSet: TClientDataSet);
var
  FieldName: string;
begin
  FieldName := GetSinglePrimaryKeyName;
  if GetDataSet.Locate(FieldName, DataSet.FieldByName(FieldName).Value, []) then
    LoadData(DataSet)
  else
    raise S2DataNotFound.Create(ClassName, 'ModifyRecord'); 
  OnModifyRecord(GetDataSet);
end;

procedure TS2ServerDataModel.OnAppendRecord(DataSet: TDataSet);
begin

end;

procedure TS2ServerDataModel.OnDeleteRecord(DataSet: TDataSet);
begin

end;

procedure TS2ServerDataModel.OnModifyRecord(DataSet: TDataSet);
begin

end;

procedure TS2ServerDataModel.LoadData(DataSet: TDataSet);
var
  FieldName: String;
  Index: Integer;
begin
  FieldName := GetSinglePrimaryKeyName;
  GetDataSet.Edit;
  for Index := 0 to DataSet.Fields.Count - 1 do
    if DataSet.Fields[Index].FieldName <> FieldName then
      GetDataSet.Fields[Index].Value := DataSet.Fields[Index].Value;
end;

function TS2ServerDataModel.GetSinglePrimaryKeyName: string;
var
  Key: TStringDynArray;
  Index: Integer;
begin
  Key := GetPrimaryKeyName;
  if Length(Key) > 1 then
  begin
    SetLength(Key, 0);
    raise S2Exception.Create(ClassName, 'DeleteRecord', '只能处理单键!');
  end
  else
  begin
    Result := Key[0];
    SetLength(Key, 0);    
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -