unit sfContnrs;

interface

{$DEFINE MULTI_THREAD_QUEUE} //线程安全版本,如果不需要线程安全,请注释掉此行代码

{$IFDEF MULTI_THREAD_QUEUE}
uses
    Windows;
{$ENDIF}

type
  TsfQueue=class
  private
    FCapacity:Integer;
    FTmpBuff:Pointer;
    FBuff:Pointer;
    FPosition:Integer;
  {$IFDEF MULTI_THREAD_QUEUE}
    FCS:TRTLCriticalSection;
  {$ENDIF}
    //\\
    FPushIndex:Integer;
    FPopIndex:Integer;

procedure Lock();
    procedure UnLock();
    procedure Inernal_SetCapacity(const Value:Integer);
    //\\
    procedure setCapacity(const Value: Integer);
    function getCapacity: Integer;
  public
    constructor Create(InitCapacity: Integer=1024);
    destructor  Destroy();override;
    //\\
    function Push(AItem: Pointer): Pointer;
    function Pop(): Pointer;
  public
    property Capacity:Integer read getCapacity write setCapacity;
  end;

implementation

{ TsfQueue }

constructor TsfQueue.Create(InitCapacity:Integer);
begin
  {$IFDEF MULTI_THREAD_QUEUE}
     InitializeCriticalSection(FCS);
  {$ENDIF}

if InitCapacity < 1024 then InitCapacity := 1024;

Inernal_SetCapacity(InitCapacity);

end;

destructor TsfQueue.Destroy;
begin
  FreeMem(FBuff);
  if FTmpBuff <> nil then
    FreeMem(FTmpBuff);
  //\\
  {$IFDEF MULTI_THREAD_QUEUE}
     DeleteCriticalSection(FCS);
  {$ENDIF}

inherited;
end;

procedure TsfQueue.Lock;
begin
  {$IFDEF MULTI_THREAD_QUEUE}
     EnterCriticalSection(FCS);
  {$ENDIF}
end;

procedure TsfQueue.UnLock;
begin
  {$IFDEF MULTI_THREAD_QUEUE}
      LeaveCriticalSection(FCS);
  {$ENDIF}
end;

procedure TsfQueue.Inernal_SetCapacity(const Value: Integer);
var
  PageCount,ASize:Integer;
begin
    if Value > FCapacity then
    begin
      if FTmpBuff <> nil then
        FreeMem(FTmpBuff);

//扩容
      ASize := Value * 4;//计算出所需要的字节数量
      Pagecount := ASize div 4096;
      if (ASize mod 4096) > 0 then Inc(PageCount);

//转移数据
      GetMem(FTmpBuff,PageCount * 4096);
      FillChar(FTmpBuff^,PageCount * 4096,#0);

if FBuff <> nil then
      begin
        Move(FBuff^,FTmpBuff^,FCapacity * 4);
        FreeMem(FBuff);
      end;

FBuff := FTmpBuff;

//计算新的容量
      FCapacity := (PageCount * 4096) div 4;

if FCapacity >= 2048 then
      begin
         //FTmpBuff 分配用于Pop时候,移动内存用
         GetMem(FTmpBuff,PageCount * 4096);
      end
      else
        FTmpBuff := nil;
    end;
end;

function TsfQueue.Pop: Pointer;
  procedure AdjuestMem();
  var
    pSrc:PInteger;
    pTmp:Pointer;
  begin
    FillChar(FTmpBuff^,FCapacity * 4,#0);
    pSrc := PInteger(FBuff);
    Inc(pSrc,FPopIndex);
    Move(pSrc^,FTmpBuff^,(FCapacity - FPopIndex) * 4);
    //\\
    //交换指针
    pTmp    := FBuff;
    FBuff   := FTmpBuff;
    FTmpBuff := pTmp;
    //\\
  end;

const
    _MoveRange_ = 2048;

var
  P:PInteger;
begin
  Lock();
  try
    Result := nil;
    if (FPopIndex = FPushIndex) then
      Exit;
    P := PInteger(FBuff);
    Inc(P,FPopIndex);
    Result := Pointer(P^);
    Inc(FPopIndex);
    //队列底部空余内存达到 8192 整体搬迁
    if FPopIndex = _MoveRange_ then
    begin
      AdjuestMem();
      FPopIndex := 0;
      Dec(FPushIndex,_MoveRange_);
    end;
  finally
    UnLock();
  end;
end;

function TsfQueue.Push(AItem: Pointer): Pointer;
var
  P:PInteger;
begin
  Lock();
  try
    P := PInteger(FBuff);
    Inc(P,FPushIndex);
    P^ := Integer(AItem);
    Inc(FPushIndex);
    if FPushIndex >= FCapacity then
    begin
      //扩容加 1024 个位置
      Inernal_SetCapacity(FCapacity + 1024);
    end;
  finally
    UnLock();
  end;
end;

procedure TsfQueue.setCapacity(const Value: Integer);
begin
  Lock();
  try
    Inernal_SetCapacity(Value);
  finally
    UnLock();
  end;
end;

function TsfQueue.getCapacity: Integer;
begin
  Lock();
  try
    Result := Self.FCapacity;
  finally
    UnLock();
  end;
end;

end.

//测试函数

procedure TfrmMain.btnQueueClick(Sender: TObject);
var
  A:TsfQueue; //优化后的高速队类实现(线程安全)
  B:TQueue;
  Index:Integer;
begin
  A := TsfQueue.Create();
  B := TQueue.Create();
  SW.Start();
  for Index := 1 to 10000 * 2 do
  begin
    b.Push(0);
  end;
  for Index := 1 to 10000 * 2 do
  begin
    b.Pop();
  end;

SW.Stop();

showMessage(IntToStr(SW.ElapsedMiliseconds));

end;

转自:http://www.cnblogs.com/lwm8246/archive/2011/10/06/2200009.html

一个队列类的实现(比delphi自带的速度快70倍)(线程安全版本)的更多相关文章

  1. 10 DelayQueue 延时队列类——Live555源码阅读(一)基本组件类

    这是Live555源码阅读的第一部分,包括了时间类,延时队列类,处理程序描述类,哈希表类这四个大类. 本文由乌合之众 lym瞎编,欢迎转载 www.cnblogs.com/oloroso/ 本文由乌合 ...

  2. C++学习笔记50:队列类模板

    队列是只能向一端添加元素,从另一端删除元素的线性群体 循环队列 在想象中将数组弯曲成环形,元素出队时,后继元素不移动,每当队尾达到数组最后一个元素时,便再回到数组开头. 队列类模板 //Queue.h ...

  3. 控制uniFrame显示的一个管理类

    控制uniFrame显示的一个管理类 (2016-03-29 06:41:17) 转载▼ 标签: delphi 分类: uniGUI 利用uniGUI Frame的机制来搭建项目,是非常好的实现方式, ...

  4. WorldWind源码剖析系列:下载队列类DownloadQueue

    下载队列类DownloadQueue代表具有优先级的下载队列,该类的存储下载请求的数组链表专门按一定的优先级来存储下载请求的.该类的类图如下. 下载队列类DownloadQueue各个字段的含义说明如 ...

  5. 固定尺寸内存块的缓冲队列类及C++实现源代码

    -------------------------------------------------------------------------------- 标题: 固定尺寸内存块的缓冲队列类及实 ...

  6. 有意思的RTL函数RegisterClass(在持久化中,你生成的一个新类的对象,系统并不知道他是如何来的,因此需要你注册)good

    例子1:Delphi中使用纯正的面向对象方法(这个例子最直接) Delphi的VCL技术使很多程序员能够非常快速的入门:程序员门只要简单的拖动再加上少量的几个Pascal语句,呵呵,一个可以运行得非常 ...

  7. PHP用单例模式实现一个数据库类

    使用单例模式的出发点: 1.php的应用主要在于数据库应用, 所以一个应用中会存在大量的数据库操作, 使用单例模式, 则可以避免大量的new 操作消耗的资源. 2.如果系统中需要有一个类来全局控制某些 ...

  8. 使用代码向一个普通的类注入Spring的实例

    转载请在页首注明作者与原文地址 一:应用场景 什么是普通的类,就是没有@Controller,@Service,@Repository,@Component等注解修饰的类,同时xml文件中,也没有相应 ...

  9. 一个Java文件至多包含一个公共类

    编写一个java源文件时,该源文件又称为编译单元.一个java文件可以包含多个类,但至多包含一个公共类,作为编译时该java文件的公用接口,公共类的名字和源文件的名字要相同,源文件名字的格式为[公共类 ...

随机推荐

  1. es6记录

    3.5? 一.const 1.冻结对象 const foo = Object.freeze({}); // 常规模式时,下面一行不起作用: // 严格模式时,该行会报错 foo.prop = ; 2. ...

  2. HDU 1203 【01背包/小数/概率DP】

    I NEED A OFFER! Time Limit: 2000/1000 MS (Java/Others) Memory Limit: 65536/32768 K (Java/Others) Tot ...

  3. hdu3001(状态压缩DP)

    hdu3001 题意 选择从任意一点出发,经过所有点的最小花费(经过每个点的次数不能多于 2 次). 分析 类似于 poj3311 经过每个点的次数有限制,考虑用三进制数存储每个点被访问过的次数,其它 ...

  4. (转) view视图的放大、缩小、旋转

    控件移动,放大,缩小,旋转 1,代码添加控件 例如: /* 1.创建一个控件 2.设置控件的位置,大小 3.设置控件所需要的各个属性 4.添加入父控件 5.添加监听 */ UIButton *btn1 ...

  5. [BZOJ 2547] 玩具兵

    Link: BZOJ 2547 传送门 Solution: 很容易通过解可行性的单调性想到二分答案,接下来考虑如何验证解 发现一个很奇妙的条件:步兵和骑兵的个数相同 因此交换位置时不用考虑可行性,保证 ...

  6. [JSOI2009] 有趣的游戏

    1444: [Jsoi2009]有趣的游戏 Time Limit: 10 Sec  Memory Limit: 64 MBSubmit: 1800  Solved: 645[Submit][Statu ...

  7. jsp笔记3(内置对象)

    jsp脚本中的9个内置对象: 1.application:javax.servlet.ServletContext的实例对象,该实例对象代表jsp所属的web应用本身,可用于在jsp页面或Servle ...

  8. 【MySQL】undo,redo,2PC,恢复思维导图

    http://blog.itpub.net/22664653/viewspace-2131353/

  9. sqlserver 出现sql被锁时,查看加锁和被锁的sql

    原文:sqlserver 出现sql被锁时,查看加锁和被锁的sql DECLARE @spid INT DECLARE @blk INT DECLARE @count INT DECLARE @ind ...

  10. DNX 概览

    来源https://docs.asp.net/en/latest/dnx/overview.html .NET Execution Environment是什么 .NET Execution Envi ...