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

最新推荐文章于 2026-05-15 05:21:09 发布

转载最新推荐文章于 2026-05-15 05:21:09 发布 · 1.5k 阅读

收录于

DELPHI

本文介绍了一个线程定时器组件TThreadTimer，用于周期性执行任务，并实现了一个泛型对象池TObjectPool，利用该定时器进行定期检查与维护。

笔记

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.