unit AdoconnectPool;

interface

uses

  Classes, Windows, SysUtils, ADODB, IniFiles, forms;

type

  TADOConnectionPool = class(TObject)

  private

    FObjList:TThreadList;

    FTimeout: Integer;

    FMaxCount: Integer;

    FSemaphore: Cardinal;

    function CreateNewInstance(List:TList): TADOConnection;

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

    procedure Unlock(var Value: TADOConnection);

  end;

var

  ConnPool: TADOConnectionPool;

  g_ini: TIniFile;

implementation

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

begin

  FObjList:=TThreadList.Create;

  FTimeout := 3000;              // 3 second

  FMaxCount := ACapicity;

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

end;

function TADOConnectionPool.CreateNewInstance(List:TList): TADOConnection;

var

  p: TADOConnection;

 

  function GetConnStr: string;

  begin

    try

      Result := g_ini.ReadString('ado','connstr','');

    except

      Exit;

    end;

  end;

begin

  try

    p := TADOConnection.Create(nil);

    p.ConnectionString := GetConnStr;

    p.LoginPrompt := False;

    p.Connected:=True;

    p.Tag := 1;

    List.Add(p);

    Result := p;

  except

    on E: Exception do

    begin

      Result := nil;

      Exit;

    end;

  end;

end;

destructor TADOConnectionPool.Destroy;

var

  i: Integer;

  List:TList;

begin

  List:=FObjList.LockList;

  try

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

    begin

      TADOConnection(List[i]).Free;

    end;

  finally

    FObjList.UnlockList;

  end;

  FObjList.Free;

  FObjList := nil;

  CloseHandle(FSemaphore);

  inherited;

end;

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

begin

  try

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

    if Result then

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

  except

    Result :=False;

    Exit;

  end;

end;

function TADOConnectionPool.Lock: TADOConnection;

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

          PostMessage(Application.MainForm.Handle,8888,13,0);

          Exit;

        end;

      end;

      if List.Count < MaxCount then

      begin

        Result := CreateNewInstance(List);

        PostMessage(Application.MainForm.Handle,8888,11,0);

      end;

    finally

      FObjList.UnlockList;

    end;

  except

    Result := nil;

    Exit;

  end;

end;

procedure TADOConnectionPool.Unlock(var Value: TADOConnection);

var

  List:TList;

begin

  try

    List:=FObjList.LockList;

    try

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

      ReleaseSemaphore(FSemaphore, 1, nil);

    finally

      FObjList.UnlockList;

    end;

    PostMessage(Application.MainForm.Handle, 8888, 12, 0);

  except

    Exit;

  end;

end;

initialization

  ConnPool := TADOConnectionPool.Create();

  g_ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'server.ini');

finalization

  FreeAndNil(ConnPool);

  FreeAndNil(g_ini);

end.