池

原来写的池子过于复杂，功能看似很全面，其实很没有效率可言，实际中也抵消掉了用池的效能方面的增长。

拿原来的数据连接池来说吧，空闲的，占用的对象都在池中，对象一多，遍历的时候要判断是否空闲对象，其实是挺费时的。

另外还有定时遍历池的机制，对象空闲超过预定时间的释放掉。

在看了DATASNAP的线程池后，特别地深有感慨，真的是返朴归真难。

从池中获取一个对象不要遍历，也不要判断对象的状态。

凡池中有的对象就都是可用的，要取就取的是第一个对象。

这才是高效能的池。

unit untGlobal;

interface

uses
System.SysUtils;

type
TDBParams = record
driveId: string;
ip: string;
database: string;
user: string;
password: string;
end;

type
TPoolParams = record
poolSize: Integer;
maxValue: Integer;
end;

var
DBParams: TDBParams;
poolParams: TPoolParams;

implementation

end.

unit untDBPool;

interface

uses
Classes, SyncObjs, SysUtils,
DateUtils, untDB, Windows, untGlobal;

type
TDBPool = class
private
FCriticalSection: TCriticalSection;
FObjs: TList;
FActiveObjs: integer;
FDatabaseParams: TDBParams;
public
constructor Create; overload;
destructor Destroy; override;
procedure Init;
function Lock: TfrmDB;
procedure Unlock(Value: TfrmDB);
function NewObj: TfrmDB;
property ActiveObjs: integer read FActiveObjs default 0;
property DatabaseParams: TDBParams read FDatabaseParams
write FDatabaseParams;
end;

var
DBPool: TDBPool;

implementation

uses untLog;

constructor TDBPool.Create;
begin
FObjs := TList.Create;
FCriticalSection := TCriticalSection.Create;
end;

destructor TDBPool.Destroy;
begin
while FObjs.Count > 0 do
begin
TfrmDB(FObjs[0]).Free;
FObjs.Delete(0);
end;
FreeAndNil(FObjs);
FreeAndNil(FCriticalSection);
inherited Destroy;
end;

procedure TDBPool.Init;
var
db: TfrmDB;
begin
while FObjs.Count < poolParams.poolSize do
begin
db := NewObj;
if db <> nil then
begin
db.ConnectDB;
FObjs.Add(db);
end;
end;
end;

function TDBPool.Lock: TfrmDB;
begin
FCriticalSection.Enter;
try
if FObjs.Count > 0 then
begin
Result := TfrmDB(FObjs[0]);
if not Result.Connected then
Result.ConnectDB;
FObjs.Delete(0);
end
else
Result := nil;
finally
FCriticalSection.Leave;
end;
if Result = nil then
begin
Result := NewObj;
if Result <> nil then
begin
Result.ConnectDB;
Result.Tag := 5;
end;
end;
end;

function TDBPool.NewObj: TfrmDB;
begin
Result := nil;
if poolParams.maxValue = 0 then
begin
Result := TfrmDB.Create(nil);
Result.DatabaseParams := Self.DatabaseParams;
InterlockedIncrement(FActiveObjs);
end
else if (poolParams.maxValue <> 0) and (FActiveObjs < poolParams.maxValue)
then
begin
Result := TfrmDB.Create(nil);
Result.DatabaseParams := Self.DatabaseParams;
InterlockedIncrement(FActiveObjs);
end;
end;

procedure TDBPool.Unlock(Value: TfrmDB);
procedure _Free;
begin
Value.DisConnectDB;
FreeAndNil(Value);
Dec(FActiveObjs);
end;

begin
if Value = nil then
exit;
FCriticalSection.Enter;
try
if Value.Tag = 5 then
begin
_Free;
end
else
begin
if FObjs.Count < poolParams.poolSize then
begin
FObjs.Add(Value);
end
else
_Free;
end;
finally
FCriticalSection.Leave;
end;
end;

end.

unit untMethodPool;

interface

uses
Classes, SyncObjs, SysUtils,
DateUtils, ServerMethodsUnit1, Windows, untGlobal;

type
TMethodPool = class
private
FCriticalSection: TCriticalSection;
FObjs: TList;
FActiveObjs: integer;
public
constructor Create; overload;
destructor Destroy; override;
procedure Init;
function Lock: TServerMethods1;
procedure Unlock(Value: TServerMethods1);
function NewObj: TServerMethods1;
property ActiveObjs: integer read FActiveObjs default 0;
end;

var
MethodPool: TMethodPool;

implementation

uses untLog;

constructor TMethodPool.Create;
begin
FObjs := TList.Create;
FCriticalSection := TCriticalSection.Create;
end;

destructor TMethodPool.Destroy;
begin
while FObjs.Count > 0 do
begin
TServerMethods1(FObjs[0]).Free;
FObjs.Delete(0);
end;
FreeAndNil(FObjs);
FreeAndNil(FCriticalSection);
inherited Destroy;
end;

procedure TMethodPool.Init;
var
db: TServerMethods1;
begin
while FObjs.Count < poolParams.poolSize do
begin
db := NewObj;
if db <> nil then
begin
FObjs.Add(db);
end;
end;
end;

function TMethodPool.Lock: TServerMethods1;
begin
FCriticalSection.Enter;
try
if FObjs.Count > 0 then
begin
Result := TServerMethods1(FObjs[0]);
FObjs.Delete(0);
end
else
Result := nil;
finally
FCriticalSection.Leave;
end;
if Result = nil then
begin
Result := NewObj;
if Result <> nil then
begin
Result.Tag := 5;
end;
end;
end;

function TMethodPool.NewObj: TServerMethods1;
begin
Result := nil;
if poolParams.maxValue = 0 then
begin
Result := TServerMethods1.Create(nil);
InterlockedIncrement(FActiveObjs);
end
else if (poolParams.maxValue <> 0) and (FActiveObjs < poolParams.maxValue)
then
begin
Result := TServerMethods1.Create(nil);
InterlockedIncrement(FActiveObjs);
end;
end;

procedure TMethodPool.Unlock(Value: TServerMethods1);
procedure _Free;
begin
FreeAndNil(Value);
Dec(FActiveObjs);
end;

begin
if Value = nil then
exit;
FCriticalSection.Enter;
try
if Value.Tag = 5 then
begin
_Free;
end
else
begin
if FObjs.Count < poolParams.poolSize then
begin
FObjs.Add(Value);
end
else
_Free;
end;
finally
FCriticalSection.Leave;
end;
end;

end.