unit untDBPool;
{$I def.inc}
interface
uses
Classes, SyncObjs, SysUtils,
DateUtils, untDB, Windows, untGlobal;
type
TLoopThread=class(TThread)
private
CS: TCriticalSection;
protected
procedure Execute; override;
public
constructor Create; overload;
destructor Destroy; override;
end;
TDBPool = class
private
FCS: TCriticalSection;
FFreelist, FUsedList: TList;
FCount: integer;
FDatabaseParams: TDBParams;
public
constructor Create; overload;
destructor Destroy; override;
procedure Init;
function Lock: TfrmDB;
procedure Unlock(Value: TfrmDB);
function NewObj: TfrmDB;
property Count: integer read FCount default 0;
property DatabaseParams: TDBParams read FDatabaseParams
write FDatabaseParams;
end;
var
DBPool: TDBPool;
loopThread: TLoopThread;
implementation
uses untLog;
constructor TDBPool.Create;
begin
FFreelist := TList.Create;
FUsedList := TList.Create;
FCS := TCriticalSection.Create;
loopThread := TLoopThread.Create;
end;
destructor TDBPool.Destroy;
begin
while FFreelist.Count > 0 do
begin
TfrmDB(FFreelist[0]).con.Close;
TfrmDB(FFreelist[0]).Free;
FFreelist.Delete(0);
end;
while FUsedList.Count > 0 do
begin
TfrmDB(FFreelist[0]).con.Close;
TfrmDB(FUsedList[0]).Free;
FUsedList.Delete(0);
end;
FreeAndNil(FFreelist);
FreeAndNil(FUsedList);
FreeAndNil(FCS);
loopThread.Terminate;
loopThread.WaitFor;
FreeAndNil(loopThread);
inherited Destroy;
end;
procedure TDBPool.Init;
var
f: TfrmDB;
begin
while FFreelist.Count < poolParams.poolSize do
begin
f := NewObj;
if f <> nil then
begin
f.TimeStamp := GetTickCount;
f.ConnectDB;
FFreelist.Add(f);
end;
end;
end;
function TDBPool.Lock: TfrmDB;
begin
FCS.Enter;
try
if FFreelist.Count > 0 then
begin
Result := TfrmDB(FFreelist[0]);
if not Result.Connected then
Result.ConnectDB;
FFreelist.Delete(0);
FUsedList.Add(Result);
end
else
Result := nil;
if Result = nil then
begin
Result := NewObj;
if Result <> nil then
begin
Result.ConnectDB;
Result.Tag := 5;
end;
end;
finally
FCS.Leave;
end;
end;
function TDBPool.NewObj: TfrmDB;
begin
Result := nil;
if poolParams.maxValue = 0 then
begin
Result := TfrmDB.Create(nil);
Result.DatabaseParams := Self.DatabaseParams;
inc(FCount);
end
else if (poolParams.maxValue <> 0) and (FCount < poolParams.maxValue)
then
begin
Result := TfrmDB.Create(nil);
Result.DatabaseParams := Self.DatabaseParams;
inc(FCount);
end;
end;
procedure TDBPool.Unlock(Value: TfrmDB);
procedure _Free;
begin
Value.DisConnectDB;
FreeAndNil(Value);
Dec(FCount);
end;
begin
if Value = nil then
exit;
FCS.Enter;
try
if Value.Tag = 5 then
begin
_Free;
end
else
begin
if FFreelist.Count < poolParams.poolSize then
begin
FUsedList.Delete(FUsedList.IndexOf(Value));
FFreelist.Add(Value);
Value.TimeStamp:=GetTickCount;
end
else
_Free;
end;
finally
FCS.Leave;
end;
end;
{ TLoopThread }
constructor TLoopThread.Create;
begin
inherited Create(False);
Self.FreeOnTerminate := false;
CS := TCriticalSection.Create;
end;
destructor TLoopThread.Destroy;
begin
CS.Free;
inherited;
end;
procedure TLoopThread.Execute;
var
i: Integer;
begin
inherited;
while not Self.Terminated do
begin
Sleep(5*60*1000);
CS.Enter;
try
if not Assigned(DBPool) then Continue;
if DBPool.FFreelist.Count <=0 then Continue;
for i := DBPool.FFreelist.Count -1 downto 0 do
begin
if ((GetTickCount-TfrmDB(DBPool.FFreelist[i]).TimeStamp) div (60*1000))
>=Cardinal(poolParams.timeout) then
begin
TfrmDB(DBPool.FFreelist[i]).con.Close;
TfrmDB(DBPool.FFreelist[i]).Free;
DBPool.FFreelist.Delete(i);
end else Continue;
end;
finally
CS.Leave;
end;
end;
end;
end.