delphi 助手helper应用之二 线程助手

测试平台 win7 64+ delphixe 10.3

功能：多线程访问同一个文档

界面：

主界面代码：

unit MainFormU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  System.Generics.Collections, System.Classes, FileWriterThreadU;

type
  TMainForm = class(TForm)
    btnStart: TButton;
    ListBox1: TListBox;
    Timer1: TTimer;
    procedure btnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    FOutputFile: TStreamWriter;
    FRunningThreads: TObjectList<TFileWriterThread>;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.btnStartClick(Sender: TObject);
var
  I: Integer;
  Th: TFileWriterThread;
begin
  for I := 1 to 10 do
  begin
    Th := TFileWriterThread.Create(FOutputFile);
    FRunningThreads.Add(Th);
  end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Th: TFileWriterThread;
begin
  for Th in FRunningThreads do
    Th.Terminate;
  FRunningThreads.Free; // Implicit WaitFor...
  FOutputFile.Free;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FRunningThreads := TObjectList<TFileWriterThread>.Create(true);
  FOutputFile := TStreamWriter.Create(
    TFileStream.Create('OutputFile.txt', fmCreate or fmShareDenyWrite));{先创建后准备写操作}
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
  Th: TFileWriterThread;
begin
  ListBox1.Items.BeginUpdate;
  try
    ListBox1.Items.Clear;
    for Th in FRunningThreads do
    begin
      if Th.WaitFor(0) = WAIT_TIMEOUT then
        ListBox1.Items.Add(Format('%5d RUNNING', [Th.ThreadID]))
      else
        ListBox1.Items.Add(Format('%5d TERMINATED', [Th.ThreadID]))
    end;
  finally
    ListBox1.Items.EndUpdate;
  end;
end;

end.

 

---

引用的单元

unit FileWriterThreadU;

interface

uses
  System.Classes, System.SyncObjs, System.SysUtils, System.IOUtils;

type
  TThreadHelper = class helper for TThread  {助手  ：}
  public
    function WaitFor(ATimeout: Cardinal): LongWord; platform;
  end;

{TTimer事件处理程序中使用的WaitFor方法不是标准TThread类的一部分，而是使用类助手引入的。 这是因为TThread类上存在的标准WaitFor方法不会为等待提供超时，因此它会永远等待。 如果要检查线程是否已终止，或者只是想在等待线程终止时让GUI响应，则无法使用WaitFor方法执行此操作。 因此，我们添加了一个提供超时的新WaitFor方法。 当您调用WaitFor（0）时，您只询问线程是否仍在运行。 这是助手的另一个好用途。}

  TFileWriterThread = class(TThread)
  private
    FStreamWriter: TStreamWriter;
  protected
    procedure Execute; override;
  public
    constructor Create(AStreamWriter: TStreamWriter);
  end;

implementation

{$IF Defined(MSWINDOWS)}

uses
  Winapi.Windows;
{$IFEND}

constructor TFileWriterThread.Create(AStreamWriter: TStreamWriter);
begin
  FStreamWriter := AStreamWriter;
  inherited Create(false);

end;

procedure TFileWriterThread.Execute;
var
  I: Integer;
  NumLines: Integer;
begin
  inherited;
  NumLines := 11 + Random(50);
  for I := 1 to NumLines do
  begin
    TThread.Sleep(200);
    TMonitor.Enter(FStreamWriter);
    try
      FStreamWriter.WriteLine(Format('THREAD %5d - ROW %2d', [TThread.CurrentThread.ThreadID, I]));
    finally
      TMonitor.Exit(FStreamWriter);
    end;
    if Terminated then
      Break;
  end;
end;

{ TThreadHelper }

function TThreadHelper.WaitFor(ATimeout: Cardinal): LongWord;
begin
{$IF Defined(MSWINDOWS)}
  Result := WaitForSingleObject(Handle, ATimeout);
{$ELSE}
  raise Exception.Create('Available only on MS Windows');
{$IFEND}
end;

initialization

Randomize; // we'll use Random function in the thread.

end.