工作中用的数据库连接池,非常好用,和大家分享一下。也希望共同探讨。
unit uAdoDb; interface uses SysUtils, Classes, DB, ADODB, Variants, ActiveX, IdGlobal, SyncObjs, Windows, IdThread, DateUtils, Math; type TObjectEvent = procedure(Sender: TObject; var AObject: TObject) of object; TADOConnectionPool = class; EConnPoolException = class(Exception) end; IDBConnection = interface(IInterface) function Connection: TADOConnection; function GetRefCount: integer; function GetLastAccess: TDateTime; function NoInUse: Boolean; stdcall; property LastAccess: TDateTime read GetLastAccess; property RefCount: integer read GetRefCount; end; TPoolDBConnection = class(TComponent, IDBConnection) SQLConnection1: TADOConnection; private CriticalSection: TCriticalSection; protected FRefCount: integer; FLastAccess: TDateTime; Semaphore: THandle; function _AddRef: integer; stdcall; function _Release: integer; stdcall; function GetLastAccess: TDateTime; function GetRefCount: integer; function NoInUse: Boolean; stdcall; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Connection: TADOConnection; end; TCleanupThread = class(TThread) private FCleanupDelay: integer; protected CriticalSection: TCriticalSection; ConnectionPool: TADOConnectionPool; procedure Execute; override; constructor Create(CreateSuspended: Boolean; const CleanupDelayMinutes: integer); end; TADOConnectionPool = class(TObject) private FPool: array of IDBConnection; FLock: array of TCriticalSection; FTimeout: LargeInt; CleanupThread: TCleanupThread; Semaphore: THandle; cs: TCriticalSection; FOnCreateObject: TObjectEvent; FPoolSize: integer; public constructor Create(const PoolSize: integer = 10; const CleanupDelayMinutes: integer = 5; const Timeoutms: LargeInt = 60000); overload; destructor Destroy; override; function Acquire: IDBConnection; procedure ClearLock; function NewItem(const Index: integer): IDBConnection; property OnCreateObject: TObjectEvent read FOnCreateObject write FOnCreateObject; end; { 数据库操作基类 } TAdoDb = class protected // public // 通用数据库处理 class function GetFirstValInt(const sSql: string; const AConn: TADOConnection; DefaultVal: integer = 0): integer; class function GetFirstValDbl(const sSql: string; const AConn: TADOConnection; DefaultVal: Double = 0): Double; class function GetFirstValStr(const sSql: string; const AConn: TADOConnection; DefaultVal: string = ''): string; class function GetSomeValStr(const sSql: string; const AConn: TADOConnection; const sSplit: string = #13#10; bTrim: Boolean = False): string; end; TAdoDbServer = class(TAdoDb) private FConnectionString: string; procedure SetConnectionString(const Value: string); public ConnectTimeout: integer; FConnections: TADOConnectionPool; constructor Create; reintroduce; virtual; destructor Destroy; override; procedure CreateConnection(Sender: TObject; var AObject: TObject); function ExecSQL(const Value: string): Boolean; function GetFirstValInt(const sSql: string; DefaultVal: integer = 0): integer; function GetFirstValDbl(const sSql: string; DefaultVal: Double = 0): Double; function GetFirstValStr(const sSql: string; DefaultVal: string = ''): string; function GetSomeValStr(const sSql: string; const sSplit: string = #13#10; bTrim: Boolean = False): string; property Connections: TADOConnectionPool read FConnections; property ConnectionString: string read FConnectionString write SetConnectionString; end; /// //////////////////////////////////////////////////////////////////////////// implementation { TAdoDbServer } constructor TAdoDbServer.Create; begin inherited Create; FConnections := TADOConnectionPool.Create(20, 2); FConnections.OnCreateObject := CreateConnection; ConnectTimeout := 1000 * 10; end; destructor TAdoDbServer.Destroy; begin FConnections.Free; inherited; end; procedure TAdoDbServer.CreateConnection(Sender: TObject; var AObject: TObject); var tcp: TADOConnection; begin try tcp := TADOConnection.Create(nil); tcp.ConnectionTimeout := Self.ConnectTimeout; tcp.ConnectionString := ConnectionString; tcp.LoginPrompt := False; tcp.Connected := true; except on E: Exception do begin tcp.Free; raise; end; end; AObject := tcp; end; function TAdoDbServer.ExecSQL(const Value: string): Boolean; var conn: IDBConnection; Qry2: TADOQuery; begin Result := False; conn := Connections.Acquire; Qry2 := TADOQuery.Create(nil); try Qry2.Connection := conn.Connection; Qry2.SQL.Text := Value; Qry2.ExecSQL; Qry2.Close; Result := true; finally freeandnil(Qry2); end; end; function TAdoDbServer.GetFirstValDbl(const sSql: string; DefaultVal: Double = 0): Double; var conn: IDBConnection; begin conn := FConnections.Acquire; try Result := inherited GetFirstValDbl(sSql, conn.Connection, DefaultVal); finally end; end; function TAdoDbServer.GetFirstValInt(const sSql: string; DefaultVal: integer = 0): integer; var conn: IDBConnection; begin conn := FConnections.Acquire; try Result := inherited GetFirstValInt(sSql, conn.Connection, DefaultVal); finally end; end; function TAdoDbServer.GetFirstValStr(const sSql: string; DefaultVal: string = ''): string; var conn: IDBConnection; begin conn := FConnections.Acquire; try Result := inherited GetFirstValStr(sSql, conn.Connection, DefaultVal); finally end; end; function TAdoDbServer.GetSomeValStr(const sSql: string; const sSplit: string = #13#10; bTrim: Boolean = False): string; var conn: IDBConnection; begin conn := FConnections.Acquire; try Result := inherited GetSomeValStr(sSql, conn.Connection, sSplit, bTrim); finally end; end; procedure TAdoDbServer.SetConnectionString(const Value: string); begin FConnectionString := Value; end; /// //////////////////////////////////////////////////////////////////////////// { TAdoDb } class function TAdoDb.GetFirstValDbl(const sSql: string; const AConn: TADOConnection; DefaultVal: Double): Double; var myQry: TADOQuery; begin Result := DefaultVal; myQry := TADOQuery.Create(nil); myQry.Connection := AConn; try myQry.SQL.Text := sSql; myQry.Open; if (myQry.Eof or myQry.Fields[0].IsNull) then Result := DefaultVal else Result := myQry.Fields[0].Value; finally myQry.Close; myQry.Free; end; end; class function TAdoDb.GetFirstValInt(const sSql: string; const AConn: TADOConnection; DefaultVal: integer): integer; var myQry: TADOQuery; begin Result := DefaultVal; myQry := TADOQuery.Create(nil); myQry.Connection := AConn; try myQry.SQL.Text := sSql; myQry.Open; if (myQry.Eof or myQry.Fields[0].IsNull) then Result := DefaultVal else Result := myQry.Fields[0].Value; finally myQry.Close; myQry.Free; end; end; class function TAdoDb.GetFirstValStr(const sSql: string; const AConn: TADOConnection; DefaultVal: string): string; var myQry: TADOQuery; begin Result := DefaultVal; myQry := TADOQuery.Create(nil); myQry.Connection := AConn; try myQry.SQL.Text := sSql; myQry.Open; if (myQry.Eof or myQry.Fields[0].IsNull) then Result := DefaultVal else Result := myQry.Fields[0].Value; finally myQry.Close; myQry.Free; end; end; class function TAdoDb.GetSomeValStr(const sSql: string; const AConn: TADOConnection; const sSplit: string; bTrim: Boolean): string; var sFldName, sOne: string; myQry: TADOQuery; begin Result := ''; myQry := TADOQuery.Create(nil); myQry.Connection := AConn; // 查询结果 try myQry.SQL.Text := sSql; myQry.Open; sFldName := myQry.Fields[0].FieldName; while not myQry.Eof do begin sOne := myQry.FieldByName(sFldName).AsString; // Fields[0].Value; if bTrim then sOne := Trim(sOne); if Result <> '' then Result := Result + sSplit; Result := Result + sOne; myQry.Next; end; finally myQry.Close; myQry.Free; end; end; constructor TPoolDBConnection.Create(AOwner: TComponent); begin inherited Create(AOwner); CoInitialize(nil); end; destructor TPoolDBConnection.Destroy; begin if Assigned(SQLConnection1) then begin SQLConnection1.Close; freeandnil(SQLConnection1); end; CoUninitialize; inherited Destroy; end; { TConnectionModule } function TPoolDBConnection.Connection: TADOConnection; begin Result := SQLConnection1; end; function TPoolDBConnection.GetLastAccess: TDateTime; begin Result := FLastAccess; end; function TPoolDBConnection.GetRefCount: integer; begin Result := FRefCount; end; function TPoolDBConnection.NoInUse: Boolean; begin Result := FRefCount = 1 end; function TPoolDBConnection._AddRef: integer; begin CriticalSection.Enter; try // Result := InterlockedIncrement(FRefCount); Inc(FRefCount); Result := FRefCount; finally CriticalSection.Leave; end; end; function TPoolDBConnection._Release: integer; begin CriticalSection.Enter; try Dec(FRefCount); Result := FRefCount; // Result := InterlockedDecrement(FRefCount); if Result = 0 then Destroy else Self.FLastAccess := now; finally CriticalSection.Leave; if FRefCount = 1 then ReleaseSemaphore(Semaphore, 1, nil); end; end; constructor TCleanupThread.Create(CreateSuspended: Boolean; const CleanupDelayMinutes: integer); begin inherited Create(true); FCleanupDelay := CleanupDelayMinutes; if not CreateSuspended then Resume; end; procedure TCleanupThread.Execute; var i: integer; tmp: string; begin while true do begin if Terminated then exit; // sleep for delay Sleep(ceil(FCleanupDelay / 2) * 1000 * 60); if Terminated then exit; ConnectionPool.cs.Enter; try for i := low(ConnectionPool.FPool) to High(ConnectionPool.FPool) do begin try if (ConnectionPool.FPool[i] <> nil) and (ConnectionPool.FPool[i].RefCount = 1) and (MinutesBetween(ConnectionPool.FPool[i].LastAccess, now) >= FCleanupDelay) then ConnectionPool.FPool[i] := nil; except on E: Exception do tmp := E.Message; end; end; finally ConnectionPool.cs.Leave; end; // try end; // while end; constructor TADOConnectionPool.Create(const PoolSize: integer = 10; const CleanupDelayMinutes: integer = 5; const Timeoutms: LargeInt = 60000); begin FPoolSize := PoolSize; FTimeout := Timeoutms; Semaphore := CreateSemaphore(nil, PoolSize, PoolSize, ''); cs := TCriticalSection.Create; SetLength(FPool, PoolSize); SetLength(FLock, PoolSize); CleanupThread := TCleanupThread.Create(true, CleanupDelayMinutes); with CleanupThread do begin FreeOnTerminate := true; Priority := tpLower; ConnectionPool := Self; Resume; end; end; function TADOConnectionPool.Acquire: IDBConnection; var i: integer; WaitResult: integer; begin Result := nil; WaitResult := WaitForSingleObject(Semaphore, FTimeout); if WaitResult <> WAIT_OBJECT_0 then raise EConnPoolException.Create('服务器忙'); cs.Enter; try for i := Low(FPool) to High(FPool) do begin if FPool[i] = nil then begin Result := NewItem(i); FPool[i] := Result; exit; end; if FPool[i].NoInUse then begin Result := FPool[i]; exit; end; end; // for finally cs.Leave; end; end; destructor TADOConnectionPool.Destroy; var i: integer; begin // Free any remaining connections CleanupThread.Terminate; cs.Enter; try for i := Low(FPool) to High(FPool) do FPool[i] := nil; SetLength(FPool, 0); finally cs.Leave; end; cs.Free; // Release the semaphore CloseHandle(Semaphore); ClearLock; inherited; end; procedure TADOConnectionPool.ClearLock; var i: integer; begin for i := Low(FLock) to High(FLock) do begin if FLock[i] <> nil then FLock[i].Free; end; SetLength(FLock, 0); end; function TADOConnectionPool.NewItem(const Index: integer): IDBConnection; var tmpobj: TObject; DM: TPoolDBConnection; begin DM := TPoolDBConnection.Create(nil); DM.Semaphore := Self.Semaphore; FLock[index] := TCriticalSection.Create; DM.CriticalSection := FLock[Index]; FOnCreateObject(Self, tmpobj); DM.SQLConnection1 := TADOConnection(tmpobj); Result := DM; end; end. |
|