udataaccess.pas

抽象三层访问数据库示例

{*******************************************************}
{       软件名称: --通用--                              }
{       单元名称: uDataAccess.pas                       }
{       中文名称: 数据访问基类                          }
{       单元描述:                                       }
{       创    建: SamonHua                              }
{       创建日期: 2007-12-18                            }
{       修    改: 参见VSS记录                           }
{       版权所有 (C)2002-2007 深圳壹平台信息技术有限公司}
{*******************************************************}
unit uDataAccess;

interface

uses
  SysUtils, Windows, Classes, Variants, DB, DBClient, Provider, uCommon,
  uIDataAccess, uDataCopy, uDataAccessCommon;

type
  TDataAccess = class(TComponent, IDataAccess)
  private
    FWebURL: string;
    FDBType: string;
    FDBHost: string;
    FDBName: string;
    FDBUserName: string;
    FDBPassword: string;
    FDBConnectString: string;
    FExtendConfig: string;
    FQueryDataProvider: TDataSetProvider;
    FUpdateDataProvider: TDataSetProvider;
    FUpdateDataCDS: TClientDataSet;
    function GetQueryDataProvider: TDataSetProvider;
    function GetUpdateDataProvider: TDataSetProvider;
    function GetUpdateDataCDS: TClientDataSet;
  protected
    function GetWebURL: string;
    function GetDBHost: string;
    function GetDBName: string;
    function GetDBPassword: string;
    function GetDBType: string;
    function GetDBUserName: string;
    function GetDBConnectString: string;
    function GetExtendConfig: string;
    procedure SetWebURL(const Value: string);
    procedure SetDBHost(const Value: string);
    procedure SetDBName(const Value: string);
    procedure SetDBPassword(const Value: string);
    procedure SetDBType(const Value: string);
    procedure SetDBUserName(const Value: string);
    procedure SetDBConnectString(const Value: string);
    procedure SetExtendConfig(const Value: string);
    //数据提供对象
    property QueryDataProvider: TDataSetProvider read GetQueryDataProvider;
    property UpdateDataProvider: TDataSetProvider read GetUpdateDataProvider;
    //临时数据集对象
    property UpdateDataCDS: TClientDataSet read GetUpdateDataCDS;
    //获取实际数据查询对象
    function GetQueryDataSet: TDataSet; virtual; abstract;
    function GetUpdateDataSet: TDataSet; virtual; abstract;
    function DoQueryData(ASQL: string): OleVariant; virtual; abstract;
    //检查是否是单表更新
    function CheckSimpleTableUpdate(DataSet: TClientDataSet; Data: OleVariant; KeyFields: string): Boolean; virtual;
    function UpdateBatchDataSet(BatchDataSet: TBatchDataSet): boolean; virtual;
    procedure ClientDataSetReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
  public
    property WebURL: string read GetWebURL write SetWebURL;
    property DBType: string read GetDBType write SetDBType;
    property DBHost: string read GetDBHost write SetDBHost;
    property DBName: string read GetDBName write SetDBName;
    property DBUserName: string read GetDBUserName write SetDBUserName;
    property DBPassword: string read GetDBPassword write SetDBPassword;
    property DBConnectString: string read GetDBConnectString write SetDBConnectString;
    property ExtendConfig: string read GetExtendConfig write SetExtendConfig;
    function GetData(const TableNameOrSQL: string): OleVariant; virtual;
    function GetXMLData(const TableNameOrSQL: string): OleVariant; virtual;
    function GetID(const TableName: string): string; virtual; abstract;
    function UpdateData(Data: OleVariant; const TableNameOrSQL, KeyFields: string): Boolean; virtual; abstract;
    function ExcuteSQL(const ASQL: string): Boolean; virtual; abstract;
    function UpdateBatchData(BatchDataList: TList): Boolean; virtual;
    function GetBlobContent(const TableName, KeyFieldName, KeyFieldValue, BlobFieldName: string;
      BlobFieldContent: TStream): boolean; virtual; abstract;
    function UpdateBlobContent(const TableName, KeyFieldName, KeyFieldValue, BlobFieldName: string;
      BlobFieldContent: TStream): boolean; virtual; abstract;
    function GetFileContent(const AFileName: string; FileContent: TStream): boolean; virtual; abstract;
    procedure CheckDBClientEnvironment; virtual;
    function BeginTrans: integer; virtual; abstract;
    procedure CommitTrans; virtual; abstract;
    procedure RollbackTrans; virtual; abstract;
    function InTransaction: boolean; virtual; abstract;
  end;

{$R MidasRes.RES}

implementation

{ TDataAccess }

function TDataAccess.GetData(const TableNameOrSQL: string): OleVariant;
var
  i: integer;
  strSQL: string;
  DataArray: TDataArray;

  function GetSQL(ASQL: string): string;
  begin
    Result := ASQL;
    if Pos(' ', Result) = 0 then//仅表名
      Result := Format('select * from %s', [Result]);
  end;
begin
  try
    if Pos(TableNameOrSQL, ';') > 0 then//检查是否多条语句
    begin
      //确定数组边界
      SetLength(DataArray, SubStrCount(TableNameOrSQL));
      for i := Low(DataArray) to High(DataArray) do
      begin
        strSQL := CopySubStr(TableNameOrSQL, i);
        DataArray[i] := DoQueryData(GetSQL(strSQL));
      end;
      Result := DataArray;
    end
    else
      Result := DoQueryData(GetSQL(TableNameOrSQL));
  except
    on e: Exception do
      raise Exception.CreateFmt('不能查询数据数据。'
        + #13#10'SQL:'#13#10'%s'
        + #13#10'错误:'#13#10'%s', [TableNameOrSQL, e.Message]);
  end;
end;

function TDataAccess.GetQueryDataProvider: TDataSetProvider;
begin
  if not Assigned(FQueryDataProvider) then
  begin
    FQueryDataProvider := TDataSetProvider.Create(Self);
    FQueryDataProvider.Name := 'QueryDataProvider';
    FQueryDataProvider.DataSet := GetQueryDataSet;
  end;
  Result := FQueryDataProvider;
end;

function TDataAccess.GetDBConnectString: string;
begin
  Result := FDBConnectString;
end;

function TDataAccess.GetDBHost: string;
begin
  Result := FDBHost;
end;

function TDataAccess.GetDBName: string;
begin
  Result := FDBName;
end;

function TDataAccess.GetDBPassword: string;
begin
  Result := FDBPassword;
end;

function TDataAccess.GetDBType: string;
begin
  Result := FDBType;
end;

function TDataAccess.GetDBUserName: string;
begin
  Result := FDBUserName;
end;

function TDataAccess.GetExtendConfig: string;
begin
  Result := FExtendConfig;
end;

function TDataAccess.GetXMLData(const TableNameOrSQL: string): OleVariant;
var
  tmpCDS: TClientDataSet;
begin
  //仅当查询一个SQL时有效，否则抛异常
  tmpCDS := TClientDataSet.Create(nil);
  try
    tmpCDS.Data := GetData(TableNameOrSQL);
    Result := tmpCDS.XMLData;
  finally
    tmpCDS.Free;
  end;
end;

procedure TDataAccess.SetDBConnectString(const Value: string);
begin
  FDBConnectString := Value;
end;

procedure TDataAccess.SetDBHost(const Value: string);
begin
  FDBHost := Value;
end;

procedure TDataAccess.SetDBName(const Value: string);
begin
  FDBName := Value;
end;

procedure TDataAccess.SetDBPassword(const Value: string);
begin
  FDBPassword := Value;
end;

procedure TDataAccess.SetDBType(const Value: string);
begin
  FDBType := Value;
end;

procedure TDataAccess.SetDBUserName(const Value: string);
begin
  FDBUserName := Value;
end;

procedure TDataAccess.SetExtendConfig(const Value: string);
begin
  FExtendConfig := Value;
end;

function TDataAccess.GetUpdateDataProvider: TDataSetProvider;
begin
  if not Assigned(FUpdateDataProvider) then
  begin
    FUpdateDataProvider := TDataSetProvider.Create(Self);
    FUpdateDataProvider.Name := 'UpdateDataProvider';
    FUpdateDataProvider.DataSet := GetUpdateDataSet;
  end;
  Result := FUpdateDataProvider;
end;

function TDataAccess.GetUpdateDataCDS: TClientDataSet;
begin
  if not Assigned(FUpdateDataCDS) then
  begin
    UpdateDataProvider;
    FUpdateDataCDS := TClientDataSet.Create(Self);
    FUpdateDataCDS.OnReconcileError := ClientDataSetReconcileError;
    FUpdateDataCDS.Name := 'UpdateDataCDS';
    FUpdateDataCDS.ProviderName := 'UpdateDataProvider';
  end;
  Result := FUpdateDataCDS;
end;

function TDataAccess.GetWebURL: string;
begin
  Result := FWebURL;
end;

procedure TDataAccess.SetWebURL(const Value: string);
begin
  FWebURL := Value;
  if (FWebURL <> '') and (FWebURL[Length(FWebURL)] <> '/') then
    FWebURL := FWebURL + '/';
end;

procedure TDataAccess.CheckDBClientEnvironment;
var
  strMidasFileName: string;
  tmpMidasRes: TResourceStream;
begin
  strMidasFileName := GetSysDirectory + 'midas.dll';
  if not FileExists(strMidasFileName) then
  begin
    tmpMidasRes := TResourceStream.Create(HInstance, 'MDIAS', PChar('DLLFILE'));
    tmpMidasRes.SaveToFile(strMidasFileName);
    WinExec(PChar('regsvr32 midas.dll'), SW_HIDE);
  end;
end;

function TDataAccess.CheckSimpleTableUpdate(DataSet: TClientDataSet;
  Data: OleVariant; KeyFields: string): Boolean;
var
  i: integer;
  tmpCDS: TClientDataSet;
  blnNeedCopy: boolean;
  tmpDataSetCopy: TDataCopy;
begin
  //检查是否是简单的单表更新，即传入的结果集是单表查询还是联合查询得到的结果。如果不是单表则通过复制数据处理。
  //返回true则表示此过程已经处理，调用处不用再赋结果集了
  result := false;
  if (DataSet = nil) or (not DataSet.Active) then
    exit;
  blnNeedCopy := false;
  tmpCDS := TClientDataSet.Create(self);
  tmpDataSetCopy := TDataCopy.Create(self);
  try
    tmpCDS.Data := Data;
    blnNeedCopy := tmpCDS.FieldCount <> DataSet.FieldCount;
    if not blnNeedCopy then
      for i := 0 to tmpCDS.FieldCount - 1 do
        if DataSet.FieldList.IndexOf(tmpCDS.Fields[i].FieldName) = -1 then
        begin
          blnNeedCopy := True;
          break;
        end;
    if not blnNeedCopy then
      exit;
    tmpDataSetCopy.SourceDataSet := tmpCDS;
    tmpDataSetCopy.SourceKey := KeyFields;
    tmpDataSetCopy.TargetDataSet := DataSet;
    tmpDataSetCopy.TargetKey := KeyFields;
    tmpDataSetCopy.CloneAllData;
    result := true;
  finally
    tmpCDS.Free;
    tmpDataSetCopy.Free;
  end;
end;

function TDataAccess.UpdateBatchData(BatchDataList: TList): Boolean;
var
  i: integer;
begin
//BatchDataList: TBatchDataSet列表
  BeginTrans;
  for i := 0 to BatchDataList.Count - 1 do
  begin
    if BatchDataList.Items[i] = nil then
      Continue;
    if not UpdateBatchDataSet(TBatchDataSet(BatchDataList.Items[i])) then
    begin
      RollbackTrans;
      raise Exception.Create('批量更新失败,事务已回滚');
    end;
  end;
  CommitTrans;
end;

function TDataAccess.UpdateBatchDataSet(
  BatchDataSet: TBatchDataSet): boolean;
begin
  Result := UpdateData(BatchDataSet.Data, BatchDataSet.TableName, BatchDataSet.KeyFields);
end;

procedure TDataAccess.ClientDataSetReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  raise e;
end;

end.