unit SqlStoredPool;

interface

uses

  Classes, Windows, SysUtils, forms, DB, SqlExpr, FMTBcd;

type

  TSQLStoredPool = class(TObject)

  private

    FObjList:TThreadList;

    FTimeout: Integer;

    FMaxCount: Integer;

    FSemaphore: Cardinal;

    function CreateNewInstance(List:TList): TSQLStored;

    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: TSQLStored;

    procedure UnLock(var Value: TSQLStored);

  end;

var

  DBXStoredPool: TSQLStoredPool;

implementation

constructor TSQLStoredPool.Create(ACapicity:Integer=30);

begin

  FObjList:=TThreadList.Create;

  FTimeout := 3000;

  FMaxCount := ACapicity;

  FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);   

end;

function TSQLStoredPool.CreateNewInstance(List:TList): TSQLStored;

var

  p: TSQLStored;

begin

  try

    p := TSQLStored.Create(nil);

    p.Tag := 1;

    List.Add(p);

    Result := p;

  except

    Result := nil;

    Exit;

  end;

end;

destructor TSQLStoredPool.Destroy;

var

  i: Integer;

  List:TList;

begin

  List:=FObjList.LockList;

  try

    for i := List.Count - 1 downto 0 do

    begin

      TSQLStored(List[i]).Free;

    end;

  finally

    FObjList.UnlockList;

  end;

  FObjList.Free;

  FObjList := nil;

  CloseHandle(FSemaphore);

  inherited Destroy;

end;

function TSQLStoredPool.GetLock(List:TList;Index: Integer): Boolean;

begin

  try

    Result := TSQLStored(List[Index]).Tag = 0;

    if Result then

      TSQLStored(List[Index]).Tag := 1;

  except

    Result :=False;

    Exit;

  end;

end;

function TSQLStoredPool.Lock: TSQLStored;

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 := TSQLStored(List[i]);

       //   PostMessage(Application.MainForm.Handle, 8888,23,0);

          Exit;

        end;

      end;

      if List.Count < MaxCount then

      begin

        Result := CreateNewInstance(List);

      //  PostMessage(Application.MainForm.Handle, 8888,21,0);

      end;

    finally

      FObjList.UnlockList;

    end;

  except

    Result :=nil;

    Exit;

  end;

end;

procedure TSQLStoredPool.Unlock(var Value: TSQLStored);

var

  List:TList;

begin

  try

    List:=FObjList.LockList;

    try

      TSQLStored(List[List.IndexOf(Value)]).Tag :=0;

      ReleaseSemaphore(FSemaphore, 1, nil);

    finally

      FObjList.UnlockList;

    end;

  //  PostMessage(Application.MainForm.Handle, 8888, 22, 0);

  except

    Exit;

  end;

end;

initialization

  DBXStoredPool := TSQLStoredPool.Create();

finalization

  FreeAndNil(DBXStoredPool); 

end.