ADOQuery数据集对象池

unit AdoqueryPool;

interface

uses
  Classes, Windows, SysUtils, ADODB, forms;

type
  TADOQueryPool = class(TObject)
  private
    FObjList:TThreadList;
    FTimeout: Integer;
    FMaxCount: Integer;
    FSemaphore: Cardinal;
    function CreateNewInstance(List:TList): TADOQuery;
    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: TADOQuery;
    procedure UnLock(var Value: TADOQuery);
  end;

var
  QryPool: TADOQueryPool;

implementation

constructor TADOQueryPool.Create(ACapicity:Integer=30);
begin
  FObjList:=TThreadList.Create;
  FTimeout := 3000;
  FMaxCount := ACapicity;
  FSemaphore := CreateSemaphore(nil, FMaxCount, FMaxCount, nil);   
end;

function TADOQueryPool.CreateNewInstance(List:TList): TADOQuery;
var
  p: TADOQuery;
begin
  try
    p := TADOQuery.Create(nil);
    p.Tag := 1;
    List.Add(p);
    Result := p;
  except
    Result := nil;
    Exit;
  end;
end;

destructor TADOQueryPool.Destroy;
var
  i: Integer;
  List:TList;
begin
  List:=FObjList.LockList;
  try
    for i := List.Count - 1 downto 0 do
    begin
      TADOQuery(List[i]).Free;
    end;
  finally
    FObjList.UnlockList;
  end;
  FObjList.Free;
  FObjList := nil;
  CloseHandle(FSemaphore);
  inherited Destroy;
end;

function TADOQueryPool.GetLock(List:TList;Index: Integer): Boolean;
begin
  try
    Result := TADOQuery(List[Index]).Tag = 0;
    if Result then
      TADOQuery(List[Index]).Tag := 1;
  except
    Result :=False;
    Exit;
  end;
end;

function TADOQueryPool.Lock: TADOQuery;
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 := TADOQuery(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 TADOQueryPool.Unlock(var Value: TADOQuery);
var
  List:TList;
begin
  try
    List:=FObjList.LockList;
    try
      TADOQuery(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
  QryPool := TADOQueryPool.Create();
finalization
  FreeAndNil(QryPool);  

end.

 

posted @   delphi中间件  阅读(785)  评论(0编辑  收藏  举报
编辑推荐:
· AI与.NET技术实操系列(二):开始使用ML.NET
· 记一次.NET内存居高不下排查解决与启示
· 探究高空视频全景AR技术的实现原理
· 理解Rust引用及其生命周期标识(上)
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
阅读排行:
· DeepSeek 开源周回顾「GitHub 热点速览」
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布:重大改进与新特性概览!
· AI与.NET技术实操系列(二):开始使用ML.NET
· 单线程的Redis速度为什么快?
点击右上角即可分享
微信分享提示