Delphi对象池MyObjectPool.pas
对象池一般在服务端使用,所以稳定性是第一的。
欢迎提意见
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的更多相关文章
- delphi新语法之泛型实现的对象池模板
现在的DELPHI因为支持泛型的语法,所以也能支持模板编程了. // 标准模板 unit UntPools; interface uses Classes, SysUtils, Unt ...
- 论DATASNAP中间件对象池
在此,笔者以DATASNAP为例,其它中间件以此类推. 中间件为什么要使用对象池? 对象池——让所有的对象免堕轮回之苦,对象不再为其生和死而烦恼. 要想让中间件长久稳定地运行,做到无人值守,对象池很重 ...
- Java 中的对象池实现
点赞再看,动力无限.Hello world : ) 微信搜「程序猿阿朗 」. 本文 Github.com/niumoo/JavaNotes 和 未读代码博客 已经收录,有很多知识点和系列文章. 最近在 ...
- 设计模式之美:Object Pool(对象池)
索引 意图 结构 参与者 适用性 效果 相关模式 实现 实现方式(一):实现 DatabaseConnectionPool 类. 实现方式(二):使用对象构造方法和预分配方式实现 ObjectPool ...
- Egret中的对象池ObjectPool
为了可以让对象复用,防止大量重复创建对象,导致资源浪费,使用对象池来管理. 对象池具体含义作用,自行百度. 一 对象池A 二 对象池B 三 字符串key和对象key的效率 一 对象池A /** * 对 ...
- 对象池与.net—从一个内存池实现说起
本来想写篇关于System.Collections.Immutable中提供的ImmutableList里一些实现细节来着,结果一时想不起来源码在哪里--为什么会变成这样呢--第一次有了想写分析的源码 ...
- 通用对象池ObjectPool的一种简易设计和实现方案
对象池,最简单直接的作用当然是通过池来减少创建和销毁对象次数,实现对象的缓存和复用.我们熟知的线程池.数据库连接池.TCP连接池等等都是非常典型的对象池. 一个基本的简易对象池的主要功能实现我认为应该 ...
- paip.提升性能----数据库连接池以及线程池以及对象池
paip.提升性能----数据库连接池以及线程池以及对象池 目录:数据库连接池c3po,线程池ExecutorService:Jakartacommons-pool对象池 作者Attilax 艾龙, ...
- common-pool2对象池(连接池)的介绍及使用
我们在服务器开发的过程中,往往会有一些对象,它的创建和初始化需要的时间比较长,比如数据库连接,网络IO,大数据对象等.在大量使用这些对象时,如果不采用一些技术优化,就会造成一些不可忽略的性能影响.一种 ...
随机推荐
- Spring 多数据源事务配置问题
2009-12-22 在SpringSide 3 中,白衣提供的预先配置好的环境非常有利于用户进行快速开发,但是同时也会为扩展带来一些困难.最直接的例子就是关于在项目中使用多个数据源的问题,似乎 很难 ...
- python正则检测密码合法性
客户系统升级,要求用户密码符合一定的规则,即:包含大小写字母.数字.符号,长度不小于8,于是先用python写了个简单的测试程序: #encoding=utf-8 #----------------- ...
- IPsec ISAKMP(转)
IPsec ISAKMP 2010-08-10 11:47:01 标签:IPsec 职场 休闲 ISAKMP Interne 安全连接和密钥管理协议(ISAKMP)是 IPsec 体系结构中的一种主要 ...
- Linux内核的ioctl函数学习
Linux内核的ioctl函数学习 来源:Linux公社 作者:Linux 我这里说的ioctl函数是在驱动程序里的,因为我不知道还有没有别的场合用到了ioctl, 所以就规定了我们讨论的范围.为什 ...
- magento注册
1. 地址保存 $_custom_address = array ( 'firstname' => 'Branko', 'lastname' => 'Ajzele', 'street' = ...
- Linux IO系统分析(scsi篇)
一.概述 Linux内核中SCSI子系统由SCSI上层,中间层,底层驱动模块三部分组成,负责管理SCSI资源和处理其他子系统,如文件系统,提交到SCSI子系统中的IO请求. 因此,理解SCSI子系统的 ...
- Windows Hadoop Error: JAVA_HOME is incorrectly set.
出现这个问题,首先java -version java version "1.8.0_91"Java(TM) SE Runtime Environment (build 1.8.0 ...
- golang学习笔记 --- goroutine
package main import ( "fmt" "io" "io/ioutil" "net/http" &quo ...
- 使用Object#tap使代码更优雅
今天看spree源码的时候经常看到Object#tap方法.以前只知道有这个方法,而且感觉这个方法调试的作用大于实际,今日看来以前的理解应该不够准确. 先看下官方文档上tap的例子 Yields se ...
- ReactNative 环境的搭建和启动(安卓版)
一.JAVA环境 下载 JDK 8.0 添加 %JAVA_HOME% 变量 添加 PATH:%JAVA_HOME%\bin 二.Android环境 下载 Android SDK 修复 SDK Mana ...