Data Module pool

Unit untdmpool;

Interface

Uses
Classes, syncobjs, sysutils,
Dateutils, untdata;

Type

Pserverobject = ^ tserverobject;

Tserverobject = record
Serverobject: tdmdata;
Inuse: Boolean;
End;

Tdmpool = Class
Private
Fcriticalsection: tcriticalsection;
Fserverobjects: tlist;
Fpoolsize: integer;

Public
Constructor create; overload;
Destructor destroy; override;
Function lock: tdmdata;
Procedure unlock (value: tdmdata );
Procedure Init;
Property poolsize: integer read fpoolsize write fpoolsize;
End;

VaR
G_dmpool: tdmpool;

Implementation
Uses
Untcommonfun;

Constructor tdmpool. Create;
Begin
Fpoolsize: = 20;
Fserverobjects: = tlist. Create;
Fcriticalsection: = tcriticalsection. Create;
End;

Destructor tdmpool. Destroy;
Begin
While fserverobjects. Count> 0 do
Begin
Pserverobject (fserverobjects [0]) ^. serverobject. Free;
Dispose (pserverobject (fserverobjects [0]);
Fserverobjects. Delete (0 );
End;
Freeandnil (fserverobjects );
Freeandnil (fcriticalsection );
Inherited destroy;
End;

Procedure tdmpool. init;
VaR
I: integer;
P: pserverobject;
Begin
If not assigned (fserverobjects) Then exit;
Try
For I: = 1 to fpoolsize do
Begin
New (P );
If assigned (p) then
Begin
P ^. serverobject: = tdmdata. Create (NiL );
P ^. inuse: = false;
Fserverobjects. Add (P );
End;
End;
Except
On E: exception do
Begin
Syslog. writelog (E. Message );
Exit;
End;
End;
End;

function tdmpool. lock: tdmdata;
var
I: integer;
bfound: Boolean;
begin
result: = nil;
try
fcriticalsection. enter;
try
bfound: = false;
for I: = 0 to fserverobjects. count-1 do
begin
if not pserverobject (fserverobjects [I]) ^. inuse then
begin
pserverobject (fserverobjects [I]) ^. inuse: = true;
result: = pserverobject (fserverobjects [I]) ^. serverobject;
bfound: = true;
break;
end;
If (fserverobjects. count = poolsize) and (not bfound) Then
begin
result: = tdmdata. create (NiL);
result. tag: = 5;
end;
finally
fcriticalsection. leave;
end;
quit T
On E: exception do
begin
syslog. writelog (E. message);
exit;
end;

Procedure tdmpool. Unlock (value: tdmdata );
VaR
I: integer;
Begin
If not assigned (value) then
Exit;
Try
Fcriticalsection. enter;
Try
If value. Tag = 5 then
Begin
Freeandnil (value );
End
Else
Begin
For I: = 0 to fserverobjects. Count-1 do
Begin
If value = pserverobject (fserverobjects [I]) ^. serverobject then
Begin
Pserverobject (fserverobjects [I]) ^. inuse: = false;
Break;
End;
End;
End;
Finally
Fcriticalsection. leave;
End;
Except
On E: exception do
Begin
Syslog. writelog (E. Message );
Exit;
End;
End;
End;

End.