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

📄 uadodataaccess.pas

📁 抽象三层访问数据库示例
💻 PAS
字号:
{*******************************************************}
{       软件名称: --通用--                              }
{       单元名称: uADODataAccess.pas                    }
{       中文名称: ADO数据访问类                         }
{       单元描述:                                       }
{       创    建: SamonHua                              }
{       创建日期: 2007-12-18                            }
{       修    改: 参见VSS记录                           }
{       版权所有 (C)2002-2007 深圳壹平台信息技术有限公司}
{*******************************************************}
unit uADODataAccess;

interface

uses
  SysUtils, Classes, Variants, DB, DBClient, ADODB, uCommon, Provider,
  uDataAccess;

type
  TADODataAccess = class(TDataAccess)
  private
    FADOConnection: TADOConnection;
    FADOQuery: TADOQuery;
    FADOProc: TADOStoredProc;
    FADOExecQuery: TADOQuery;
    FADOUpdateQuery: TADOQuery;
    function GetADOConnection: TADOConnection;
    function GetADOQuery: TADOQuery;
    function GetADOProc: TADOStoredProc;
    function GetADOExecQuery: TADOQuery;
    function GetADOUpdateQuery: TADOQuery;
    property ADOConnection: TADOConnection read GetADOConnection;
    property ADOQuery: TADOQuery read GetADOQuery;
    property ADOProc: TADOStoredProc read GetADOProc;
    property ADOExecQuery: TADOQuery read GetADOExecQuery;
    property ADOUpdateQuery: TADOQuery read GetADOUpdateQuery;
  protected
    function GetQueryDataSet: TDataSet; override;
    function GetUpdateDataSet: TDataSet; override;
    function DoQueryData(ASQL: string): OleVariant; override;
  public
    function GetID(const TableName: string): string; override;
    function UpdateData(Data: OleVariant; const TableNameOrSQL, KeyFields: string): Boolean; override;
    function ExcuteSQL(const ASQL: string): Boolean; override;
    function GetBlobContent(const TableName, KeyFieldName, KeyFieldValue, BlobFieldName: string;
      BlobFieldContent: TStream): boolean; override;
    function UpdateBlobContent(const TableName, KeyFieldName, KeyFieldValue, BlobFieldName: string;
      BlobFieldContent: TStream): boolean; override;
    function BeginTrans: integer; override;
    procedure CommitTrans; override;
    procedure RollbackTrans; override;
    function InTransaction: boolean; override;
  end;

implementation

{ TADODataAccess }

function TADODataAccess.ExcuteSQL(const ASQL: string): Boolean;
begin
  Result := false;
  with ADOExecQuery do
  try
    Connection.BeginTrans;
    SQL.Text := ASQL;
    ExecSQL;
    Connection.CommitTrans;
    Close;
    Result := True;
  except
    on e: Exception do
    begin
      Connection.RollbackTrans;
      raise Exception.CreateFmt('执行SQL出错,错误:%s', [e.Message]);
    end;
  end;
end;

function TADODataAccess.GetADOConnection: TADOConnection;
var
  strConnectionString: string;
begin
  if not Assigned(FADOConnection) then
  begin
    FADOConnection := TADOConnection.Create(Self);
    FADOConnection.LoginPrompt := false;
    if CompareText(DBType, 'MSSQL') = 0 then
    begin
      if DBUserName <> '' then
        strConnectionString := Format('Provider=SQLOLEDB.1;Password=%s;Persist Security Info=True;User ID=%s;Initial Catalog=%s;Data Source=%s',
          [DBPassword, DBUserName, DBName, DBHost])
      else//Windows身份认证
        strConnectionString := Format('Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=%s;Data Source=%s',
          [DBName, DBHost]);
    end
    else if CompareText(DBType, 'Oracle') = 0 then
    begin
      if DBName = '' then
        DBName := DBHost;
      //默认使用MS提供的驱动程序,如果需要指定使用Oracle提供的驱动请使用参数"UseOracleDriver"
      if ParamExists(ExtendConfig, 'UseOracleDriver') then//oracle驱动
        strConnectionString := Format('Provider=OraOLEDB.Oracle.1;Password=%s;Persist Security Info=True;User ID=%s;Data Source=%s',
          [DBPassword, DBUserName, DBName])
      else
        strConnectionString := Format('Provider=MSDAORA;Password=%s;User ID=%s;Data Source=%s',
          [DBPassword, DBUserName, DBName]);
    end
    else if CompareText(DBType, 'MSAccess') = 0 then
    begin
      if DBName = '' then
        DBName := DBHost;
      strConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Password=%s;User ID=%s;Data Source=%s;Persist Security Info=True',
        [DBPassword, DBUserName, DBName]);
    end
  end;
  Result := FADOConnection;
end;

function TADODataAccess.GetADOProc: TADOStoredProc;
begin
  if not Assigned(FADOProc) then
  begin
    FADOProc := TADOStoredProc.Create(Self);
    FADOProc.Connection := ADOConnection;
  end;
  Result := FADOProc;
end;

function TADODataAccess.GetADOQuery: TADOQuery;
begin
  if not Assigned(FADOQuery) then
  begin
    FADOQuery := TADOQuery.Create(Self);
    FADOQuery.Connection := ADOConnection;
  end;
  Result := FADOQuery;
end;

function TADODataAccess.GetQueryDataSet: TDataSet;
begin
  result := ADOQuery;
end;

function TADODataAccess.GetADOExecQuery: TADOQuery;
begin
  if not Assigned(FADOExecQuery) then
  begin
    FADOExecQuery := TADOQuery.Create(Self);
    FADOExecQuery.Connection := ADOConnection;
  end;
  Result := FADOExecQuery;
end;

function TADODataAccess.GetID(const TableName: string): string;
begin
  try
    with ADOProc do
    begin
      ProcedureName := 'get_id;1';
      Parameters.Clear;
      Parameters.CreateParameter('@RETURN_VALUE', ftInteger, pdReturnValue, 0, 0);
      Parameters.CreateParameter('@table_name', ftInteger, pdReturnValue, 0, TableName);
      Parameters.CreateParameter('@key_field', ftInteger, pdReturnValue, 0, '');
      Parameters.CreateParameter('@id', ftWideString, pdInputOutput, 18, '');
      ExecProc;
      Result := Parameters.ParamByName('@id').Value;
    end;
  except
    on e: Exception do
      raise Exception.CreateFmt('生成自动主键值失败,错误:%s', [TableName]);
  end;
end;

function TADODataAccess.DoQueryData(ASQL: string): OleVariant;
begin
  with ADOQuery do
  begin
    SQL.Text := ASQL;
    try
      Open;
      Result := QueryDataProvider.Data;
      Close;
    except
      raise;
    end;
  end;
end;

function TADODataAccess.UpdateData(Data: OleVariant; const TableNameOrSQL,
  KeyFields: string): Boolean;
var
  strTableName, strKeyFields: string;
  i: integer;
  tmpField: TField;
  blnAutoTrans: boolean;
begin
  result := false;
  if VarIsNull(Data) or VarIsEmpty(Data) then
  begin
    Result := True;
    exit;
  end;
  if not VarIsArray(Data) then
    raise Exception.Create('传入的数据集数据格式非法');
  blnAutoTrans := not InTransaction;
  if blnAutoTrans then
    BeginTrans; 
  try
    ADOUpdateQuery.Close;
    //UpdateDataProvider.DataSet := nil;//避免赋Data时出错
    UpdateDataProvider.UpdateMode := upWhereAll;
    //简单方式获取表名
    if CompareText(Copy(Trim(TableNameOrSQL), 1, 6), 'select') = 0 then
    begin
      ADOUpdateQuery.SQL.Text := TableNameOrSQL;
      strTableName := Trim(Copy(TableNameOrSQL, pos('FROM', UpperCase(TableNameOrSQL)) + 4, MaxInt));
      if Pos(' ', strTableName) > 0 then
        strTableName := Copy(strTableName, 1, pos(' ', strTableName) - 1);
    end
    //建议采用传表名的方式
    else
    begin
      ADOUpdateQuery.SQL.Text := Format('select * from %s where 1 = 2', [TableNameOrSQL]);
      strTableName := TableNameOrSQL;
    end;
    ADOUpdateQuery.Open;
    if not CheckSimpleTableUpdate(UpdateDataCDS, Data, KeyFields) then
      UpdateDataCDS.Data := Data;
    if UpdateDataCDS.ChangeCount = 0 then
    begin
      Result := True;
      exit;
    end;
    //设置字段更新方式
    if KeyFields <> '' then
    begin
      strKeyFields := StringReplace(KeyFields, ',', ';', [rfReplaceAll]);
      for i := 0 to UpdateDataCDS.FieldCount - 1 do
      begin
        //pfInUpdate, pfInWhere, pfInKey, pfHidden
        if ParamExists(strKeyFields, UpdateDataCDS.Fields[i].FieldName, true) then
          UpdateDataCDS.Fields[i].ProviderFlags := [pfInUpdate, pfInWhere, pfInKey]//ADOUpdateQuery.Fields[i].ProviderFlags + [pfInKey]
        else
          UpdateDataCDS.Fields[i].ProviderFlags := [pfInUpdate];//ADOUpdateQuery.Fields[i].ProviderFlags - [pfInWhere, pfInKey];
        ADOUpdateQuery.FieldByName(UpdateDataCDS.Fields[i].FieldName).ProviderFlags := UpdateDataCDS.Fields[i].ProviderFlags;
      end;
    end;
    try
      UpdateDataProvider.DataSet := ADOUpdateQuery;
      UpdateDataProvider.Options := UpdateDataProvider.Options +
        [poAllowCommandText, poCascadeUpdates];
      if KeyFields <> '' then
        UpdateDataProvider.UpdateMode := upWhereKeyOnly;
      result := UpdateDataCDS.ApplyUpdates(0) = 0;//更新数据至数据库中
      if blnAutoTrans then
        CommitTrans;
    except
      on e: Exception do
      begin
        if blnAutoTrans then
          RollbackTrans;
        raise Exception.CreateFmt('更新数据失败,错误:%s', [e.Message]);
      end;
    end;
  finally
    ADOUpdateQuery.Close;
    UpdateDataCDS.Close;
    if UpdateDataProvider.DataSet = nil then
      UpdateDataProvider.DataSet := ADOUpdateQuery;
  end;
end;

function TADODataAccess.GetUpdateDataSet: TDataSet;
begin
  result := ADOUpdateQuery;
end;

function TADODataAccess.GetADOUpdateQuery: TADOQuery;
begin
  if not Assigned(FADOUpdateQuery) then
  begin
    FADOUpdateQuery := TADOQuery.Create(Self);
    FADOUpdateQuery.Connection := ADOConnection;
  end;
  Result := FADOUpdateQuery;
end;

function TADODataAccess.BeginTrans: integer;
begin
  inherited;
  result := ADOConnection.BeginTrans;
end;

procedure TADODataAccess.CommitTrans;
begin
  inherited;
  if InTransaction then
    ADOConnection.CommitTrans;
end;

procedure TADODataAccess.RollbackTrans;
begin
  inherited;
  if InTransaction then
    ADOConnection.RollbackTrans;
end;

function TADODataAccess.InTransaction: boolean;
begin
  Result := ADOConnection.InTransaction;
end;

function TADODataAccess.GetBlobContent(const TableName, KeyFieldName,
  KeyFieldValue, BlobFieldName: string;
  BlobFieldContent: TStream): boolean;
var
  tmpCDS: TClientDataSet;
  strSQL, strKeyFieldList: string;
  i: integer;
begin
  Result := false;
  tmpCDS := TClientDataSet.Create(nil);
  try
    if Pos(';', KeyFieldName) > 0 then
    begin
      strKeyFieldList := '1 = 1';
      for i := 0 to SubStrCount(KeyFieldName) do
        strKeyFieldList := strKeyFieldList
          + Format(' and %s = %s', [CopySubStr(KeyFieldName, i), QuotedStr(CopySubStr(KeyFieldValue, i))]);
    end
    else
      strKeyFieldList := Format('%s = %s', [KeyFieldName, QuotedStr(KeyFieldValue)]);
    strSQL := Format('select %s from %s where %s',
      [BlobFieldName, TableName, strKeyFieldList]);
    tmpCDS.Data := GetData(strSQL);
    if tmpCDS.IsEmpty then
      exit;
    BlobFieldContent.Position := 0;
    TBlobField(tmpCDS.Fields[0]).SaveToStream(BlobFieldContent);
    Result := True;
  finally
    tmpCDS.Free;
  end;
end;

function TADODataAccess.UpdateBlobContent(const TableName, KeyFieldName,
  KeyFieldValue, BlobFieldName: string;
  BlobFieldContent: TStream): boolean;
var
  tmpCDS: TClientDataSet;
  strSQL, strKeyFieldList: string;
  i: integer;
begin
  Result := false;
  tmpCDS := TClientDataSet.Create(nil);
  try
    if Pos(';', KeyFieldName) > 0 then
    begin
      strKeyFieldList := '1 = 1';
      for i := 0 to SubStrCount(KeyFieldName) do
        strKeyFieldList := strKeyFieldList
          + Format(' and %s = %s', [CopySubStr(KeyFieldName, i), QuotedStr(CopySubStr(KeyFieldValue, i))]);
    end
    else
      strKeyFieldList := Format('%s = %s', [KeyFieldName, QuotedStr(KeyFieldValue)]);
    strSQL := Format('select %s from %s where %s',
      [BlobFieldName, TableName, strKeyFieldList]);
    tmpCDS.Data := GetData(strSQL);
    if tmpCDS.IsEmpty then
      exit;
    BlobFieldContent.Position := 0;
    tmpCDS.Edit;
    TBlobField(tmpCDS.Fields[0]).LoadFromStream(BlobFieldContent);
    tmpCDS.Post;
    Result := UpdateData(tmpCDS.Delta, TableName, KeyFieldName);
  finally
    tmpCDS.Free;
  end;
end;

end.

⌨️ 快捷键说明

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