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.
|