SQLServer访问类(带连接池和存储过程演示实例)

unit JaSQLDBAccess;

interface

uses
  SysUtils, Classes, Windows, DateUtils, ADODB, ActiveX, SyncObjs;

type

  TSQLServerQuery = class;

  { TAdoConnPoolItem - ADO连接池项 }
 
  TAdoConnPoolItem = class(TObject)
  public
    Connection: TADOConnection;
    Query: TSQLServerQuery;
    IsUsing: Boolean;
    LastUseTick: Cardinal;
  public
    destructor Destroy; override;
  end;

  { TAdoConnectionPool - ADO连接池 }
 
  TAdoConnectionPool = class(TObject)
  private
    FLock: TCriticalSection;
    FList: TList;

    function IndexOf(Query: TSQLServerQuery): Integer;
    function IsAdoConnected(AConn: TAdoConnPoolItem): Boolean;

    procedure Clear;
    procedure DeleteAndFree(Index: Integer);

    // 清除过期连接
    procedure ClearTimeOutConn(TimeOutMSecs: Cardinal);

    function GetItems(Index: Integer): TAdoConnPoolItem;
    function GetCount: Integer;
   
    property Items[Index: Integer]: TAdoConnPoolItem read GetItems; default;
  public
    constructor Create;
    destructor Destroy; override;

    // 线程锁函数
    procedure Lock;
    procedure UnLock;

    // 分配和释放Query
    function AllocQuery(ConnStr: string; ConnTimeOut, ExecTimeOut: Integer): TSQLServerQuery;
    procedure FreeQuery(AQuery: TADOQuery);

    property Count: Integer read GetCount;
  end;

  { TSQLServerQuery - SQLServer数据查询 }

  TSQLServerQuery = class(TADOQuery)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  { TBaseSQLServerAccess - SQLServer数据访问基类 }

  TBaseSQLServerAccess = class(TObject)
  private
    FConnStr: string;              // 连接字符串
    FConnectTimeOut: Integer;      // 连接超时时间
    FPoolTimeOutMSecs: Integer;    // 连接池超时时间

    FConnPool: TAdoConnectionPool;
  protected
    function GetQuery(const SqlStr: string; ExecTimeOut: Integer = 30): TSQLServerQuery;
    procedure FreeQuery(AQuery: TADOQuery);

    procedure ExecuteSql(Query: TADOQuery; const Sql: string);
  public
    constructor Create(PoolTimeOutMSecs: Integer = 60 * 1000);
    destructor Destroy; override;

    // 初始化数据库连接参数(注意：并不真正连接数据库)
    procedure Initialize(const Host,User,Pwd, Db: string; TimeOut: Integer = 15);

    // 读取数据库时间
    function ReadDBDateTime(var ADateTime: TDateTime): Boolean;

    // 读取实例
    function __ReadExample(LoginID: Integer): string;
    function __ReadExampleStore(A, B: Integer; var C: Integer): Boolean;
    function __ReadExampleStoreEx(SN: Integer; var Name: string): Boolean;
  end;

implementation

{ TBaseDbAccess }

function TBaseSQLServerAccess.GetQuery(const SqlStr: string;
  ExecTimeOut: Integer): TSQLServerQuery;
begin
  // 初始化ActiveX(为保证ADO能够执行), 内部会自动判断同一线程多次执行
  // 这一行并不影响效率，执行100W次时间才消耗大约50毫秒
  CoInitialize(nil);
 
  Result := FConnPool.AllocQuery(FConnStr, FConnectTimeOut, ExecTimeOut);
  Result.SQL.Clear;
  Result.SQL.Add(SqlStr);
end;

constructor TBaseSQLServerAccess.Create(PoolTimeOutMSecs: Integer);
begin
  inherited Create;

  FPoolTimeOutMSecs := PoolTimeOutMSecs;
  FConnPool := TAdoConnectionPool.Create;
end;

destructor TBaseSQLServerAccess.Destroy;
begin
  FConnPool.Free;
  inherited;
end;

procedure TBaseSQLServerAccess.ExecuteSql(Query: TADOQuery; const Sql: string);
begin
  Query.Close;
  Query.SQL.Clear;
  Query.SQL.Add(Sql);
  Query.ExecSQL;
end;

procedure TBaseSQLServerAccess.FreeQuery(AQuery: TADOQuery);
begin
  // 清除一下连接池中的过期连接
  FConnPool.ClearTimeOutConn(FPoolTimeOutMSecs);

  // 释放连接池中的查询
  FConnPool.FreeQuery(AQuery);
end;

procedure TBaseSQLServerAccess.Initialize(const Host,User,Pwd, Db: string;
  TimeOut: Integer);
const
  SQL_CONN = 'Provider=SQLOLEDB.1;Persist Security Info=False;' +
    'User ID=%s;Password=%s;Initial Catalog=%s;Data Source=%s';
begin
  FConnStr := Format(SQL_CONN, [User, Pwd, Db, Host]);
  FConnectTimeOut := TimeOut;
end;

function TBaseSQLServerAccess.ReadDBDateTime(var ADateTime: TDateTime): Boolean;
const
  SQLSTR_S = 'SELECT GETDATE() AS CurDateTime';
var
  Query: TADOQuery;
begin
  Result := False;

  Query := nil;
  try
    try
      Query := GetQuery(SQLSTR_S);
      Query.Active := True;

      if Query.IsEmpty then Exit;

      ADateTime := Query.FieldByName('CurDateTime').AsDateTime;

      Result := True;
    except
    end;
  finally
    if Assigned(Query) then
      FreeQuery(Query);
  end;
end;

function TBaseSQLServerAccess.__ReadExample(LoginID: Integer): string;
const
  SQLSTR = 'SELECT Password FROM UserMainInfo WHERE LoginID=%d';
var
  Query: TAdoQuery;
begin
  Result := '';

  Query := nil;
  try
    try
      Query := GetQuery(Format(SQLSTR, [LoginID]), 10);
      Query.Active := True;

      if Query.IsEmpty then Exit;

      Result := Query.FieldByName('Password').AsString;
    except
    end;
  finally
    if Assigned(Query) then
      FreeQuery(Query);
  end;
end;

function TBaseSQLServerAccess.__ReadExampleStore(A, B: Integer; var C: Integer): Boolean;
{
  // 存储过程代码
  CREATE PROCEDURE TestStore @a int ,@b int, @c int OUTPUT AS
  BEGIN
      set @c=@a*@b
  END
  GO
}
const
  SQLSTR = 'EXECUTE TestStore :a,:b,:c OUTPUT';
var
  Query: TAdoQuery;
begin
  Result := False;

  Query := nil;
  try
    try
      Query := GetQuery(SQLSTR, 10);
      Query.Parameters.ParamByName('a').Value := A;
      Query.Parameters.ParamByName('b').Value := B;

      Query.ExecSQL;

      C := Query.Parameters.ParamByName('c').Value;

      Result := True;
    except
    end;
  finally
    if Assigned(Query) then
      FreeQuery(Query);
  end;
end;

function TBaseSQLServerAccess.__ReadExampleStoreEx(SN: Integer;
  var Name: string): Boolean;
{
  // 存储过程代码
  CREATE PROCEDURE TestStoreEx @SN int  AS
  BEGIN
      DECLARE @SqlStr varchar(512)
      SET @SqlStr = 'SELECT * FROM b_group WHERE G_SNo=' + CAST( @SN AS varchar(12))
      EXEC(@SqlStr)
  END
  GO

  // 表结构
  b_group - G_Sno int, G_Name varchar(20)
}
const
  SQLSTR = 'EXECUTE TestStoreEx :SN';
var
  Query: TAdoQuery;
begin
  Result := False;

  Query := nil;
  try
    try
      Query := GetQuery(SQLSTR, 10);
      Query.Parameters.ParamByName('SN').Value := SN;
      Query.Active := True;

      if Query.IsEmpty then Exit;

      Name := Query.FieldByName('G_Name').AsString;

      Result := True;
    except
    end;
  finally
    if Assigned(Query) then
      FreeQuery(Query);
  end;
end;

{ TBcQuery }

constructor TSQLServerQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TSQLServerQuery.Destroy;
begin
  inherited;
end;

{ TAdoConnectionPool }

function TAdoConnectionPool.AllocQuery(ConnStr: string;
  ConnTimeOut, ExecTimeOut: Integer): TSQLServerQuery;
var
  I: Integer;
  NewItem: TAdoConnPoolItem;

  procedure CreateNewItem;
  begin
    NewItem := TAdoConnPoolItem.Create;

    NewItem.Connection := TADOConnection.Create(nil);
    NewItem.Connection.ConnectionString := ConnStr;
    NewItem.Connection.ConnectionTimeout := ConnTimeOut;

    NewItem.Query := TSQLServerQuery.Create(nil);
    NewItem.Query.Connection := NewItem.Connection;

    FList.Add(NewItem);

    NewItem.IsUsing := True;
    NewItem.LastUseTick := GetTickCount;
  end;

begin
  Result := nil;
  Lock;
  try
    // 寻找连接
    I := 0;
    while I < Self.Count do
    begin
      if not Items[I].IsUsing then
      begin
        if not IsAdoConnected(Items[I]) then
        begin
          DeleteAndFree(I);
          Dec(I);
        end
        else
        begin
          Items[I].IsUsing := True;
          Items[I].LastUseTick := GetTickCount;

          Result := Items[I].Query;
          Result.CommandTimeout := ExecTimeOut;
         
          Break;
        end;
      end;
     
      Inc(I);
    end;

    // 没有合适的连接，需要新创建
    if Result = nil then
    begin
      CreateNewItem;

      Result := NewItem.Query;
      Result.CommandTimeout := ExecTimeOut;
    end;
  finally
    Unlock;
  end;
end;

procedure TAdoConnectionPool.Clear;
begin
  Lock;
  try
    while FList.Count > 0 do
      DeleteAndFree(0);
  finally
    UnLock;
  end;
end;

procedure TAdoConnectionPool.ClearTimeOutConn(TimeOutMSecs: Cardinal);
  function GetTickDiff(const OldTick, NewTick: Cardinal): Cardinal;
  begin
    if NewTick >= OldTick then
      Result := NewTick - OldTick
    else
      Result := High(Cardinal) - OldTick + NewTick;
  end;
var
  I: Integer;
  ElapsedTime: Cardinal;
begin
  Lock;
  try
    for I := Self.Count-1 downto 0 do
    begin
      ElapsedTime := GetTickDiff(Items[I].LastUseTick, GetTickCount);

      if (ElapsedTime >= TimeOutMSecs) and (not Items[I].IsUsing) then
        DeleteAndFree(I);
    end;
  finally
    Unlock;
  end;
end;

constructor TAdoConnectionPool.Create;
begin
  inherited Create;

  FLock := TCriticalSection.Create;
  FList := TList.Create;
end;

procedure TAdoConnectionPool.DeleteAndFree(Index: Integer);
begin
  Items[Index].Free;
  FList.Delete(Index);
end;

destructor TAdoConnectionPool.Destroy;
begin
  Clear;
 
  FList.Free;
  FLock.Free;
  try inherited; except end;
end;

procedure TAdoConnectionPool.FreeQuery(AQuery: TADOQuery);
var
  Item: TAdoConnPoolItem;
  LIndex: Integer;
begin
  Lock;
  try
    LIndex := IndexOf(TSQLServerQuery(AQuery));
    if LIndex >= 0 then
    begin
      Item := GetItems(LIndex);
     
      Item.IsUsing := False;
      Item.LastUseTick := GetTickCount;

      AQuery.Close;
      AQuery.SQL.Clear;
    end;
  finally
    Unlock;
  end;
end;

function TAdoConnectionPool.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TAdoConnectionPool.GetItems(Index: Integer): TAdoConnPoolItem;
begin
  Result := TAdoConnPoolItem(FList[Index]);
end;

function TAdoConnectionPool.IndexOf(Query: TSQLServerQuery): Integer;
var
  I: Integer;
begin
  Result := -1;

  for I := 0 to Self.Count - 1 do
  begin
    if Items[I].Query = Query then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TAdoConnectionPool.IsAdoConnected(AConn: TAdoConnPoolItem): Boolean;
begin
  Result := False;
  AConn.IsUsing := True;
  try
    try
      AConn.Query.CommandTimeout := 3;
      AConn.Query.Close;
      AConn.Query.SQL.Clear;
      AConn.Query.SQL.Add('SELECT GETDATE()');
      AConn.Query.ExecSQL;

      Result := True;
    except
    end;
  finally
    AConn.IsUsing := False;
  end;
end;

procedure TAdoConnectionPool.Lock;
begin
  FLock.Enter;
end;

procedure TAdoConnectionPool.UnLock;
begin
  FLock.Leave;
end;

{ TAdoConnectionPoolItem }

destructor TAdoConnPoolItem.Destroy;
begin
  if Assigned(Query) then
    try Query.Free; except end;
   
  if Assigned(Connection) then
    try Connection.Free; except end;

  inherited;
end;

end.