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.

SQLServer訪問類(帶連接池和存儲過程演示實例)

C++中幾個常用的宏，能省不少代碼的

Delphi中複製帶有String的記錄結構時不能使用Move之類的內存操作函數

WIN7輸入法不能切換

RichView的幾個封裝函數(插入文本和圖片)

Delphi中模態窗口切換時隱藏問題的解決辦法

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結