DELPHI基于线程的定时器和一个泛型对象池

笔记

unit ThreadTimer;

//次编译指令仅在测试时使用,请勿在Release版本中打开
{$DEFINE RunInMainThread}

interface
uses
  SysUtils, Classes, SyncObjs;
type
  TThreadTimer = class(TObject)
  private
    FEnabled: Boolean;
    FWaitEvent: TEvent;
    FOnTimer: TNotifyEvent;
    FInterval: Integer;
    FWorkThread: TThread;
    procedure SetEnabled(const Value: Boolean);
    procedure DoInterval;
    procedure DoTimer;
    procedure StartTimer;
    procedure StopTimer;
  public
    constructor Create;
    destructor Destroy; override;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Interval: Integer read FInterval write FInterval;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

  TWorkThread = class(TThread)
  private
    FOwner: TThreadTimer;
    procedure DoTimer;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TThreadTimer);
  end;

implementation

{ TThreadTimer }

constructor TThreadTimer.Create;
begin
  inherited Create;
  FInterval := 1000;
  FWaitEvent := TEvent.Create(nil, False, False, '');
  FWorkThread := nil;
end;

destructor TThreadTimer.Destroy;
begin
  StopTimer;
  FreeAndNil(FWaitEvent);
  inherited;
end;

procedure TThreadTimer.DoInterval;
begin
  FWaitEvent.WaitFor(FInterval);
end;

procedure TThreadTimer.DoTimer;
begin
  if Assigned(FOnTimer) then
    FOnTimer(Self);
end;

procedure TThreadTimer.SetEnabled(const Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    if Value then
      StartTimer
    else
      StopTimer;
    FEnabled := Value;
  end;
end;

procedure TThreadTimer.StartTimer;
begin
  if FWorkThread = nil then
  begin
    FWorkThread := TWorkThread.Create(Self);
    FWaitEvent.ResetEvent;
    FWorkThread.Start;
  end;
end;

procedure TThreadTimer.StopTimer;
begin
  if FWorkThread <> nil then
  begin
    FWorkThread.Terminate;
    //设置信号
    FWaitEvent.SetEvent;
    //等待结束
    FWorkThread.WaitFor;
    FreeAndNil(FWorkThread);
  end;
end;

{ TWorkThread }

constructor TWorkThread.Create(AOwner: TThreadTimer);
begin
  inherited Create(True);
  FOwner := AOwner;
end;

procedure TWorkThread.DoTimer;
begin
  FOwner.DoTimer;
end;

procedure TWorkThread.Execute;
begin
  while not Self.Terminated do
  begin
    FOwner.DoInterval;
    if not Self.Terminated then
    begin
      {$IFDEF RunInMainThread}
        Synchronize(Self.DoTimer);
      {$ELSE}
        FOwner.DoTimer;
      {$ENDIF}
    end;
  end;
end;

end.

泛型对象池

unit ObjectPool;

interface
uses
  Classes, SyncObjs, SysUtils, Generics.Collections,
  ThreadTimer;
type
  TObjectPool<T> = class
  private
    FCacheList: TThreadList<T>;
    FTimer: TThreadTimer;
    FMaxPoolSize: Cardinal;
    FMinPoolSize: Cardinal;
    procedure InitObjectPool(const APoolSize: Cardinal);
  public
    constructor Create(AObject: T; AMaxPoolSize: Cardinal = 5; AMinPoolSize: Cardinal = 3);
    destructor Destroy; override;
    property MaxPoolSize: Cardinal read FMaxPoolSize write FMaxPoolSize;
    property MinPoolSize: Cardinal read FMinPoolSize write FMinPoolSize;
  end;
implementation

{ TObjectPool<T> }

constructor TObjectPool<T>.Create(AObject: T; AMaxPoolSize,
  AMinPoolSize: Cardinal);
begin
  FCacheList := TThreadList<T>.Create;
  FTimer := TThreadTimer.Create;
  FTimer.Interval := 30000; //30秒检查一次
  FMaxPoolSize := AMaxPoolSize;
  FMinPoolSize := AMinPoolSize;
  InitObjectPool(AMinPoolSize);
end;

destructor TObjectPool<T>.Destroy;
var
  I: Integer;
  LockList: TList<T>;
begin
  if Assigned(FCacheList) then
  begin
    LockList := FCacheList.LockList;
    try
    for I := 0 to LockList.Count - 1 do
      FreeAndNil(LockList.Items[I]);
    finally
      FCacheList.UnlockList;
      FCacheList.Free;
    end;
  end;
  FTimer.Free;
  inherited;
end;

procedure TObjectPool<T>.InitObjectPool(const APoolSize: Cardinal);
begin

end;

end.


  • 3
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
delphi线程池单元文件uThreadPool.pas,用法如下 type TRecvCommDataWorkItem=class(TWorkItem) public // updatetime,addtime:TDateTime; // orderid,ordertype,urljson,loadcount,savepath:string; url,Filename:string; total,order:Integer; _orderid:string; failedcount:Integer; IFCoverFile:Boolean; // 线程处理请求时触发的事件 procedure DealwithCommRecvData(Sender: TThreadsPool; WorkItem: TWorkItem; aThread: TProcessorThread); // 线程初始化时触发的事件 procedure TProcessorThreadInitializing(Sender: TThreadsPool; aThread:TProcessorThread); // 线程结束时触发的事件 procedure TProcessorThreadFinalizing(Sender: TThreadsPool; aThread:TProcessorThread); //任务队列空时触发的事件 procedure TQueueEmpty(Sender: TThreadsPool; EmptyKind: TEmptyKind); end; 先声明一个类 然后用法 FThreadPool := TThreadsPool.Create(nil); // 创建线程池 FThreadPool.ThreadsMin := 10; // 初始工作线程数 FThreadPool.ThreadsMax := 100; // 最大允许工作线程数 AWorkItem := TRecvCommDataWorkItem.Create; ISAllOverLoad:=False; AWorkItem.url:=urljson; AWorkItem.order:=i; AWorkItem.total:=JA.Count; AWorkItem.Filename:=savefilepath; AWorkItem._orderid:=orderid; AWorkItem.IFCoverFile:=IFCoverFile; FThreadPool.AddRequest(AWorkItem,True); // 向线程池分配一个任务 FThreadPool.OnProcessRequest := AWorkItem.DealwithCommRecvData; FThreadPool.OnThreadInitializing := AWorkItem.TProcessorThreadInitializing; FThreadPool.OnThreadFinalizing := AWorkItem.TProcessorThreadFinalizing; FThreadPool.OnQueueEmpty := AWorkItem.TQueueEmpty; 仔细看下线程池单元的函数说明轻松搞定。 procedure TRecvCommDataWorkItem.TQueueEmpty(Sender: TThreadsPool; EmptyKind: TEmptyKind); begin if EmptyKind=ekProcessingFinished then begin try if Assigned(geturl) then //存在的bug 如果下载文件存在的不行 begin //Sleep(200); //激活线程可能会发生在 休眠之前!! ISAl

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值