unit DSPPool;
interface
uses
Classes, Windows, SysUtils, Provider, forms;
type
TDSPPool = class(TObject)
private
FObjList:TThreadList;
FTimeout: Integer;
FMaxCount: Integer;
FSemaphore: Cardinal;
function CreateNewInstance(List:TList): TDatasetProvider;
function GetLock(List:TList;Index: Integer): Boolean;
public
property Timeout:Integer read FTimeout write FTimeout;
property MaxCount:Integer read FMaxCount;
constructor Create(ACapicity:Integer=30);overload;
destructor Destroy;override;
function Lock: TDatasetProvider;
procedure UnLock(var Value: TDatasetProvider);
end;
var
DSPPooler: TDSPPool;
implementation
constructor TDSPPool.Create(ACapicity:Integer=30);
begin
FObjList:=TThreadList.Create;
FTimeout := 3000;
FMaxCount := ACapicity;
FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);
end;
function TDSPPool.CreateNewInstance(List:TList): TDatasetProvider;
var
p: TDatasetProvider;
begin
try
p := TDatasetProvider.Create(nil);
p.Tag := 1;
List.Add(p);
Result := p;
except
Result := nil;
Exit;
end;
end;
destructor TDSPPool.Destroy;
var
i: Integer;
List:TList;
begin
List:=FObjList.LockList;
try
for i := List.Count - 1 downto 0 do
begin
TDatasetProvider(List[i]).Free;
end;
finally
FObjList.UnlockList;
end;
FObjList.Free;
FObjList := nil;
CloseHandle(FSemaphore);
inherited Destroy;
end;
function TDSPPool.GetLock(List:TList;Index: Integer): Boolean;
begin
try
Result := TDatasetProvider(List[Index]).Tag = 0;
if Result then
TDatasetProvider(List[Index]).Tag := 1;
except
Result :=False;
Exit;
end;
end;
function TDSPPool.Lock: TDatasetProvider;
var
i: Integer;
List:TList;
begin
try
Result := nil;
if WaitForSingleObject(FSemaphore, Timeout) = WAIT_FAILED then Exit;
List:=FObjList.LockList;
try
for i := 0 to List.Count - 1 do
begin
if GetLock(List,i) then
begin
Result := TDatasetProvider(List[i]);
PostMessage(Application.MainForm.Handle, 8888, 43, 0);
Exit;
end;
end;
if List.Count < MaxCount then
begin
Result := CreateNewInstance(List);
PostMessage(Application.MainForm.Handle, 8888, 41, 0);
end;
finally
FObjList.UnlockList;
end;
except
Result :=nil;
Exit;
end;
end;
procedure TDSPPool.Unlock(var Value: TDatasetProvider);
var
List:TList;
begin
try
List:=FObjList.LockList;
try
TDatasetProvider(List[List.IndexOf(Value)]).Tag :=0;
ReleaseSemaphore(FSemaphore, 1, nil);
finally
FObjList.UnlockList;
end;
PostMessage(Application.MainForm.Handle, 8888, 42, 0);
except
Exit;
end;
end;
initialization
DSPPooler := TDSPPool.Create();
finalization
FreeAndNil(DSPPooler);
end.