作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

//大家在进行数据库访问的时候,经常会将自己常用的一些写成函数的形式, 但如果是不同类型的数据库,或者想转换数据库类型,就比较麻烦了,此处提供了三个对象.TDataAccess为基类.TServerAccess为ADO类型的,TClientAccess为BDE类型的, 这几个都有点不太舒服的地方,就是没有提供初始化委托函数,而是用一个INITALL来进行初始化,大家可以自己改进,这只是我们应用的一个特例.
unit DataAccess_U;

interface
uses
  Classes, ADODB, DB, SysUtils, Dbtables, Variants, Forms;

type
  TDataAccess = class
  public
    function GetSQLValue(ASQLStr: string; var AValue: Variant): Boolean; overload; virtual;
    function GetSQLValue(ASQLStr: string; var AValue: string): Boolean; overload; virtual;

    procedure ExecSQL(ASQLStr: string); virtual; abstract;
    function OpenSQL(ASQLStr: string; var ADataSet: TDataSet): Boolean; virtual; abstract;
  end;

  TServerAccess = class(TDataAccess)
  private
    function GetCommQuery: TADOQuery;
    procedure FreeCommQuery(AQuery: TADOQuery);
  public
    ADOConnection: TADOConnection;
    ConnectString: string;
    constructor Create;
    destructor Destroy; override;

    procedure ExecSQL(ASQLStr: string); override;

    function OpenSQL(ASQLStr: string; var ADataSet: TDataSet): Boolean; override;
    procedure InitAll; virtual;
  end;

  TClientAccess = class(TDataAccess)
  private
    DataBaseName: string; //{ DONE : 等待赋值 }
    function GetCommQuery: TQuery;
    procedure FreeCommQuery(AQuery: TQuery);
  public
    constructor Create;
    procedure ExecSQL(ASQLStr: string); override;
    function OpenSQL(ASQLStr: string; var ADataSet: TDataSet): Boolean; override;

    class procedure CreateAlias;
    procedure InitAll;
  end;
implementation
constructor TServerAccess.Create;
begin
  ADOConnection := TADOConnection.Create(nil);
end;

destructor TServerAccess.Destroy;
begin
  ADOConnection.Free;
  inherited;
end;

procedure TServerAccess.ExecSQL(ASQLStr: string);
var
  tmpQuery: TADOQuery;
begin
  tmpQuery := GetCommQuery;
  try
    tmpQuery.Close;
    tmpQuery.SQL.Text := ASQLStr;
    tmpQuery.ExecSQL;
  finally
    freeCommQuery(tmpQuery);
  end;
end;
procedure TServerAccess.FreeCommQuery(AQuery: TADOQuery);
begin
  FreeAndNil(AQuery);
end;

function TServerAccess.GetCommQuery: TADOQuery;
begin
  Result := TADOQuery.Create(nil);
  Result.Connection := ADOConnection;
end;
procedure TServerAccess.InitAll;
begin

end;
function TServerAccess.OpenSQL(ASQLStr: string;
  var ADataSet: TDataSet): Boolean;
var
  tmpADOQuery: TADOQuery;
begin
  tmpADOQuery := GetCommQuery();
  tmpADOQuery.SQL.Text := ASQLStr;
  tmpADOQuery.Open;
  Result := tmpADOQuery.RecordCount > 0;
  ADataSet := tmpADOQuery;
end;
constructor TClientAccess.Create;
begin
  DataBaseName := 'selfold';
end;

class procedure TClientAccess.CreateAlias;
var
  tmpStrList: TStringList;
begin
  Session.DeleteAlias('selfold');
  Session.SaveConfigFile;
  if not Session.IsAlias('selfold') then
  begin
    tmpStrList := TStringList.Create;
    try
      tmpStrList.Add('path =' + ExtractFilePath(Application.ExeName) + 'HS_DATA');
      Session.AddAlias('selfold', 'STANDARD', tmpStrList);
      Session.SaveConfigFile;
    finally
      tmpStrList.Free;
    end;
  end;
end;

procedure TClientAccess.ExecSQL(ASQLStr: string);
var
  tmpQuery: TQuery;
begin
  tmpQuery := GetCommQuery;
  tmpQuery.SQL.Text := ASQLStr;
  tmpQuery.ExecSQL;
  FreeCommQuery(tmpQuery);
end;

procedure TClientAccess.FreeCommQuery(AQuery: TQuery);
begin
  AQuery.Free;
end;

function TClientAccess.GetCommQuery: TQuery;
begin
  Result := TQuery.Create(nil);
  Result.DatabaseName := DataBaseName;
end;

procedure TClientAccess.InitAll;
begin

end;

function TClientAccess.OpenSQL(ASQLStr: string;
  var ADataSet: TDataSet): Boolean;
var
  tmpQuery: TQuery;
begin
  tmpQuery := GetCommQuery;
  tmpQuery.RequestLive := True;
  tmpQuery.SQL.Text := ASQLStr;
  tmpQuery.Open;
  ADataSet := tmpQuery;

  Result := tmpQuery.RecordCount > 0;

end;
{ TDataAccess }

function TDataAccess.GetSQLValue(ASQLStr: string;
  var AValue: Variant): Boolean;
var
  tmpDataSet: TDataSet;
  i: Integer;
begin
  Result := OpenSQL(ASQLStr, tmpDataSet);
  try
    if Result then
    begin
      AValue := VarArrayCreate([0, tmpDataSet.FieldCount], varVariant);
      for I := 0 to tmpDataSet.FieldCount - 1 do    // Iterate
      begin
        AValue[I] := tmpDataSet.Fields[I].AsString;
      end;    // for
    end;
  finally
    tmpDataSet.Close;
    tmpDataSet.Free;
  end;

end;

function TDataAccess.GetSQLValue(ASQLStr: string;
  var AValue: string): Boolean;
var
  tmpDataSet: TDataSet;
begin
  Result := OpenSQL(ASQLStr, tmpDataSet);
  try
    if Result then
      AValue := tmpDataSet.Fields[0].AsString;

  finally
    tmpDataSet.Close;
    tmpDataSet.Free;
  end;

end;

相关软件：