对象池一般在服务端使用,所以稳定性是第一的。

欢迎提意见

unit uMyObjectPool;

interface

uses
SyncObjs, Classes, Windows, SysUtils; type
TObjectBlock = record
private
FObject:TObject;
FUsing:Boolean;
FBorrowTime:Cardinal; //借出时间
FRelaseTime:Cardinal; //归还时间
end; PObjectBlock = ^TObjectBlock; TMyObjectPool = class(TObject)
private
FObjectClass:TClass; FLocker: TCriticalSection; //全部归还信号
FReleaseSingle: THandle; //有可用的对象信号灯
FUsableSingle: THandle; FMaxNum: Integer; /// <summary>
/// 正在使用的对象列表
/// </summary>
FBusyList:TList; /// <summary>
/// 可以使用的对象列表
/// </summary>
FUsableList:TList; FName: String;
FTimeOut: Integer; procedure makeSingle;
function GetCount: Integer;
procedure lock;
procedure unLock;
protected
/// <summary>
/// 清理空闲的对象
/// </summary>
procedure clear; /// <summary>
/// 创建一个对象
/// </summary>
function createObject: TObject; virtual;
public
constructor Create(pvObjectClass: TClass = nil);
destructor Destroy; override; /// <summary>
/// 重置对象池
/// </summary>
procedure resetPool; /// <summary>
/// 借用一个对象
/// </summary>
function borrowObject: TObject; /// <summary>
/// 归还一个对象
/// </summary>
procedure releaseObject(pvObject:TObject); /// <summary>
/// 获取正在使用的个数
/// </summary>
function getBusyCount:Integer; //等待全部还回
function waitForReleaseSingle: Boolean; /// <summary>
/// 等待全部归还信号灯
/// </summary>
procedure checkWaitForUsableSingle; /// <summary>
/// 当前总的个数
/// </summary>
property Count: Integer read GetCount; /// <summary>
/// 最大对象个数
/// </summary>
property MaxNum: Integer read FMaxNum write FMaxNum; /// <summary>
/// 对象池名称
/// </summary>
property Name: String read FName write FName; /// <summary>
/// 等待超时信号灯
/// 单位毫秒
/// </summary>
property TimeOut: Integer read FTimeOut write FTimeOut;
end; implementation procedure TMyObjectPool.clear;
var
lvObj:PObjectBlock;
begin
lock;
try
while FUsableList.Count > do
begin
lvObj := PObjectBlock(FUsableList[FUsableList.Count-]);
lvObj.FObject.Free;
FreeMem(lvObj, SizeOf(TObjectBlock));
FUsableList.Delete(FUsableList.Count-);
end;
finally
unLock;
end;
end; constructor TMyObjectPool.Create(pvObjectClass: TClass = nil);
begin
inherited Create;
FObjectClass := pvObjectClass; FLocker := TCriticalSection.Create();
FBusyList := TList.Create;
FUsableList := TList.Create; //默认可以使用5个
FMaxNum := ; //等待超时信号灯 秒
FTimeOut := * ; //
FUsableSingle := CreateEvent(nil, True, True, nil); //创建信号灯,手动控制
FReleaseSingle := CreateEvent(nil, True, True, nil); makeSingle;
end; function TMyObjectPool.createObject: TObject;
begin
Result := nil;
if FObjectClass <> nil then
begin
Result := FObjectClass.Create;
end;
end; destructor TMyObjectPool.Destroy;
begin
waitForReleaseSingle;
clear;
FLocker.Free;
FBusyList.Free;
FUsableList.Free; CloseHandle(FUsableSingle);
CloseHandle(FReleaseSingle);
inherited Destroy;
end; function TMyObjectPool.getBusyCount: Integer;
begin
Result := FBusyList.Count;
end; { TMyObjectPool } procedure TMyObjectPool.releaseObject(pvObject:TObject);
var
i:Integer;
lvObj:PObjectBlock;
begin
lock;
try
for i := to FBusyList.Count - do
begin
lvObj := PObjectBlock(FBusyList[i]);
if lvObj.FObject = pvObject then
begin
FUsableList.Add(lvObj);
lvObj.FRelaseTime := GetTickCount;
FBusyList.Delete(i);
Break;
end;
end; makeSingle;
finally
unLock;
end;
end; procedure TMyObjectPool.resetPool;
begin
waitForReleaseSingle; clear;
end; procedure TMyObjectPool.unLock;
begin
FLocker.Leave;
end; function TMyObjectPool.borrowObject: TObject;
var
i:Integer;
lvObj:PObjectBlock;
lvObject:TObject;
begin
Result := nil; while True do
begin
//是否有可用的对象
checkWaitForUsableSingle;
////如果当前有1个可用,线程同时借用时,都可以直接进入等待成功。 lock;
try
lvObject := nil;
if FUsableList.Count > then
begin
lvObj := PObjectBlock(FUsableList[FUsableList.Count-]);
FUsableList.Delete(FUsableList.Count-);
FBusyList.Add(lvObj);
lvObj.FBorrowTime := getTickCount;
lvObj.FRelaseTime := ;
lvObject := lvObj.FObject;
end else
begin
if GetCount >= FMaxNum then
begin
//如果当前有1个可用,线程同时借用时,都可以直接(checkWaitForUsableSingle)成功。
continue;
//退出(unLock)后再进行等待....
//raise exception.CreateFmt('超出对象池[%s]允许的范围[%d]', [self.ClassName, FMaxNum]);
end;
lvObject := createObject;
if lvObject = nil then raise exception.CreateFmt('不能得到对象,对象池[%s]未继承处理createObject函数', [self.ClassName]); GetMem(lvObj, SizeOf(TObjectBlock));
try
ZeroMemory(lvObj, SizeOf(TObjectBlock)); lvObj.FObject := lvObject;
lvObj.FBorrowTime := GetTickCount;
lvObj.FRelaseTime := ;
FBusyList.Add(lvObj);
except
lvObject.Free;
FreeMem(lvObj, SizeOf(TObjectBlock));
raise;
end;
end; //设置信号灯
makeSingle; Result := lvObject;
//获取到
Break;
finally
unLock;
end;
end;
end; procedure TMyObjectPool.makeSingle;
begin
if (GetCount < FMaxNum) //还可以创建
or (FUsableList.Count > ) //还有可使用的
then
begin
//设置有信号
SetEvent(FUsableSingle);
end else
begin
//没有信号
ResetEvent(FUsableSingle);
end; if FBusyList.Count > then
begin
//没有信号
ResetEvent(FReleaseSingle);
end else
begin
//全部归还有信号
SetEvent(FReleaseSingle)
end;
end; function TMyObjectPool.GetCount: Integer;
begin
Result := FUsableList.Count + FBusyList.Count;
end; procedure TMyObjectPool.lock;
begin
FLocker.Enter;
end; function TMyObjectPool.waitForReleaseSingle: Boolean;
var
lvRet:DWORD;
begin
Result := false;
lvRet := WaitForSingleObject(FReleaseSingle, INFINITE);
if lvRet = WAIT_OBJECT_ then
begin
Result := true;
end;
end; procedure TMyObjectPool.checkWaitForUsableSingle;
var
lvRet:DWORD;
begin
lvRet := WaitForSingleObject(FUsableSingle, FTimeOut);
if lvRet <> WAIT_OBJECT_ then
begin
raise Exception.CreateFmt('对象池[%s]等待可使用对象超时(%d),使用状态[%d/%d]!',
[FName, lvRet, getBusyCount, FMaxNum]);
end;
end; end.

Delphi对象池MyObjectPool.pas的更多相关文章

  1. delphi新语法之泛型实现的对象池模板

    现在的DELPHI因为支持泛型的语法,所以也能支持模板编程了.   // 标准模板 unit UntPools;   interface   uses   Classes, SysUtils, Unt ...

  2. 论DATASNAP中间件对象池

    在此,笔者以DATASNAP为例,其它中间件以此类推. 中间件为什么要使用对象池? 对象池——让所有的对象免堕轮回之苦,对象不再为其生和死而烦恼. 要想让中间件长久稳定地运行,做到无人值守,对象池很重 ...

  3. Java 中的对象池实现

    点赞再看,动力无限.Hello world : ) 微信搜「程序猿阿朗 」. 本文 Github.com/niumoo/JavaNotes 和 未读代码博客 已经收录,有很多知识点和系列文章. 最近在 ...

  4. 设计模式之美:Object Pool(对象池)

    索引 意图 结构 参与者 适用性 效果 相关模式 实现 实现方式(一):实现 DatabaseConnectionPool 类. 实现方式(二):使用对象构造方法和预分配方式实现 ObjectPool ...

  5. Egret中的对象池ObjectPool

    为了可以让对象复用,防止大量重复创建对象,导致资源浪费,使用对象池来管理. 对象池具体含义作用,自行百度. 一 对象池A 二 对象池B 三 字符串key和对象key的效率 一 对象池A /** * 对 ...

  6. 对象池与.net—从一个内存池实现说起

    本来想写篇关于System.Collections.Immutable中提供的ImmutableList里一些实现细节来着,结果一时想不起来源码在哪里--为什么会变成这样呢--第一次有了想写分析的源码 ...

  7. 通用对象池ObjectPool的一种简易设计和实现方案

    对象池,最简单直接的作用当然是通过池来减少创建和销毁对象次数,实现对象的缓存和复用.我们熟知的线程池.数据库连接池.TCP连接池等等都是非常典型的对象池. 一个基本的简易对象池的主要功能实现我认为应该 ...

  8. paip.提升性能----数据库连接池以及线程池以及对象池

    paip.提升性能----数据库连接池以及线程池以及对象池 目录:数据库连接池c3po,线程池ExecutorService:Jakartacommons-pool对象池 作者Attilax  艾龙, ...

  9. common-pool2对象池(连接池)的介绍及使用

    我们在服务器开发的过程中,往往会有一些对象,它的创建和初始化需要的时间比较长,比如数据库连接,网络IO,大数据对象等.在大量使用这些对象时,如果不采用一些技术优化,就会造成一些不可忽略的性能影响.一种 ...

随机推荐

  1. 【转载】Mysql主从复制、和MySQL集群(主主复制)

    转载:https://www.cnblogs.com/phpstudy2015-6/p/6485819.html 请同时参考和结合这篇文件进行处理:https://blog.csdn.net/envo ...

  2. Dubbo OPS工具——dubbo-admin & dubbo-monitor

    1. 前言 今年八月份的时候,查看github仓库,Dubbo OPS还提供了三种工具用于Dubbo的监控运维: 九月份,伴随着Dubbo的全面快速的升级,现在仓库里Dubbo OPS下这三个工具已经 ...

  3. [转载]linux下如何查看系统和内核版本

    原文地址:linux下如何查看系统和内核版本作者:vleage 1. 查看内核版本命令: 1) [root@q1test01 ~]# cat /proc/version Linux version 2 ...

  4. SQL Server 表分区之水平表分区

    什么是表分区? 表分区分为水平表分区和垂直表分区,水平表分区就是将一个具有大量数据的表,进行拆分为具有相同表结构的若干个表:而垂直表分区就是把一个拥有多个字段的表,根据需要进行拆分列,然后根据某一个字 ...

  5. FormsAuthentication.SetAuthCookie

    这两天在研究 Forms 进行用户验证, 它本身没有什么上msdn上查一下就知道怎么个搞法了! 不过我在测试的时候发现也会产生 了一些疑问! 1. 什么我在web.config 的 authentic ...

  6. sql server 删除所有表、视图、存储过程

    如果由于外键约束删除table失败,则先删除所有约束:   --/第1步**********删除所有表的外键约束*************************/   DECLARE c1 curs ...

  7. 在Linux CentOS 6.6上安装RedisLive

    Real time dashboard for redis 安装必须软件 1.安装pip到指定的python版本下面: curl -O https://bootstrap.pypa.io/get-pi ...

  8. hibernate的findByExample 外键参数查询解决方案

    用了这么长时间的hibernate/spring,如果不是今天用的findByExample方法到现在还不知道findByExample的机制.惭愧 Class User{String usernam ...

  9. SDL相关学习

    原文地址:https://www.cnblogs.com/landmark/category/311822.html 介绍SDL图形库的使用 SDL显示文字 摘要: 前面教程里,我们只显示图片,没提到 ...

  10. Oracle 12C -- Identity Columns(标识列)

    Identity Columns很适合数据库中需要"surrogate keys"的场景.依赖sequence产生器,每行的标识列会被赋予一个自增或自减的值.缺省,标识列在创建的时 ...