适合delphi7的任务执行系统

unit ThreadPoolD7;

interface

uses
  Windows, SysUtils, Classes, Contnrs, SyncObjs;

type
  // 任务接口
  ITask = interface
    ['{AEE6EB13-5166-4412-B9DA-6A0DB61CB223}']
    procedure Execute;
  end;

  // 基础任务类（可继承重写）
  TTaskClass = class(TInterfacedObject, ITask)
  public
    procedure Execute; virtual;
  end;

  TThreadPool = class;

  TWorkerThread = class(TThread)
  private
    FOwner: TThreadPool;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TThreadPool);
  end;

  TThreadPool = class
  private
    FQueue: TObjectList;
    FLock: TCriticalSection;
    FThreads: TList;
    FShuttingDown: Boolean;
    FMaxThreads: Integer;
    function PopTask: ITask;
    function HasTask: Boolean;
  public
    constructor Create(NumThreads: Integer);
    destructor Destroy; override;
    procedure AddTask(ATask: ITask);
    procedure Shutdown;
  end;

implementation

type
  // 包装类，用于在 TObjectList 中存储接口
  TTaskHolder = class
  public
    Task: ITask;
    constructor Create(ATask: ITask);
  end;

{ TTaskClass }

procedure TTaskClass.Execute;
begin
  // 默认什么都不做，子类可重写
end;

{ TTaskHolder }

constructor TTaskHolder.Create(ATask: ITask);
begin
  inherited Create;
  Task := ATask;
end;

{ TThreadPool }

constructor TThreadPool.Create(NumThreads: Integer);
var
  I: Integer;
begin
  inherited Create;
  FMaxThreads := NumThreads;
  FQueue := TObjectList.Create(False); // 不自动释放包装对象（由接口管理）
  FLock := TCriticalSection.Create;
  FThreads := TList.Create;
  FShuttingDown := False;

  for I := 0 to FMaxThreads - 1 do
    FThreads.Add(TWorkerThread.Create(Self));
end;

destructor TThreadPool.Destroy;
begin
  Shutdown;

  while FThreads.Count > 0 do
  begin
    TThread(FThreads[0]).Free;
    FThreads.Delete(0);
  end;

  FThreads.Free;
  FQueue.Free;
  FLock.Free;
  inherited;
end;

procedure TThreadPool.AddTask(ATask: ITask);
begin
  FLock.Enter;
  try
    if FShuttingDown then
      raise Exception.Create('ThreadPool is shutting down.');

    FQueue.Add(TTaskHolder.Create(ATask));
  finally
    FLock.Leave;
  end;
end;

function TThreadPool.HasTask: Boolean;
begin
  FLock.Enter;
  try
    Result := FQueue.Count > 0;
  finally
    FLock.Leave;
  end;
end;

function TThreadPool.PopTask: ITask;
var
  Holder: TTaskHolder;
begin
  FLock.Enter;
  try
    if FQueue.Count > 0 then
    begin
      Holder := TTaskHolder(FQueue[0]);
      Result := Holder.Task;
      FQueue.Delete(0);
    end
    else
      Result := nil;
  finally
    FLock.Leave;
  end;
end;

procedure TThreadPool.Shutdown;
var
  I: Integer;
begin
  FLock.Enter;
  try
    FShuttingDown := True;
  finally
    FLock.Leave;
  end;

  for I := 0 to FThreads.Count - 1 do
    TThread(FThreads[I]).Terminate;
end;

{ TWorkerThread }

constructor TWorkerThread.Create(AOwner: TThreadPool);
begin
  inherited Create(False); // 自动启动
  FreeOnTerminate := False;
  FOwner := AOwner;
end;

procedure TWorkerThread.Execute;
var
  Task: ITask;
begin
  while not Terminated do
  begin
    if FOwner.HasTask then
    begin
      Task := FOwner.PopTask;
      if Assigned(Task) then
      begin
        try
          Task.Execute;
        except
          on E: Exception do
            OutputDebugString(PChar('任务异常: ' + E.Message));
        end;
      end;
    end
    else
      Sleep(10);
  end;
end;

end.

delphi7中使用

uses
  ThreadPoolD7;

var
  Pool: TThreadPool;

type
  TMyTask = class(TTaskClass)
  private
    FText: string;
  public
    constructor Create(const AText: string);
    procedure Execute; override;
  end;

{ TMyTask }

constructor TMyTask.Create(const AText: string);
begin
  inherited Create;
  FText := AText;
end;

procedure TMyTask.Execute;
begin
  Sleep(1000); // 模拟耗时操作
  OutputDebugString(PChar('线程执行: ' + FText));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Pool := TThreadPool.Create(4);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Task: ITask;
begin
  Task := TMyTask.Create('任务内容123');
  Pool.AddTask(Task);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Pool.Shutdown;
  Pool.Free;
end;