multithreading - Delphi - 线程内的计时器生成AV

Question

我有以下第一次正确执行的线程代码。之后，我不时在线程的 Execute 方法上得到一个 AV，例如

调试输出：TProcesses.Execute 模块“ListenOutputDebugString.exe”中地址 00409C8C 的访问冲突。读取地址 08070610 Process ListenOutputDebugString.exe (740)

我不知道是什么产生了这个 AV...

unit Unit3;

interface

uses
  Classes,
  StdCtrls,
  Windows,
  ExtCtrls,
  SysUtils,
  Variants,
  JvExGrids,
  JvStringGrid;

type
  TProcesses = class(TThread)
  private
    { Private declarations }
    FTimer :  TTimer;
    FGrid  :  TJvStringGrid;
    FJobFinished : Boolean;
    procedure OverrideOnTerminate(Sender: TObject);
    procedure DoShowData;
    procedure DoShowErrors;
    procedure OverrideOnTimer(Sender: TObject);
  protected
    procedure Execute; override;
  public
    constructor Create(aGrid : TJvStringGrid);overload;
  end;

implementation

{TProcesses }

var SharedMessage : String;
    ErrsMess      : String;
    lp            : Integer;

constructor TProcesses.Create(aGrid : TJvStringGrid);
begin
 FreeOnTerminate := True;
 FTimer := TTimer.Create(nil);
 FTimer.OnTimer := OverrideOnTerminate;
 FTimer.OnTimer := OverrideOnTimer;
 FTimer.Interval := 10000;
 FGrid := aGrid;
 inherited Create(false);
 FTimer.Enabled := true;
 FJobFinished := true;
end;

procedure TProcesses.DoShowData;
var wStrList : TStringList;
    wi,wj : Integer;
begin
// FMemo.Lines.Clear;
 for wi := 1 to FGrid.RowCount-1 do
  for wj := 0 to FGrid.ColCount-1 do
   FGrid.Cells[wj,wi] := '';
 try
  try
  wStrList := TStringList.Create;
  wStrList.Delimiter := ';';
  wStrList.StrictDelimiter := true;
  wStrList.DelimitedText := SharedMessage;
//  outputdebugstring(PChar('Processes list '+SharedMessage));
  FGrid.RowCount := wStrList.Count div 4;
  for wi := 0 to wStrList.Count-1 do
    FGrid.Cells[(wi mod 4), (wi div 4)+1] := wStrList[wi];
  Except on e:Exception do
   OutputDebugString(Pchar('TProcesses.DoShowData '+e.Message));
  end;
 finally
  FreeAndNil(wStrList);
 end;
end;

procedure TProcesses.DoShowErrors;
begin
// FMemo.Lines.Add('Error '+ ErrsMess);
 FGrid.Cells[1,1] := 'Error '+ ErrsMess;
 ErrsMess := '';
end;

procedure TProcesses.Execute;
  function EnumProcess(hHwnd: HWND; lParam : integer): boolean; stdcall;
  var
    pPid : DWORD;
    title, ClassName : string;
  begin
    //if the returned value in null the
    //callback has failed, so set to false and exit.
    if (hHwnd=NULL) then
    begin
      result := false;
    end
    else
    begin
      //additional functions to get more
      //information about a process.
      //get the Process Identification number.
      GetWindowThreadProcessId(hHwnd,pPid);
      //set a memory area to receive
      //the process class name
      SetLength(ClassName, 255);
      //get the class name and reset the
      //memory area to the size of the name
      SetLength(ClassName,
                GetClassName(hHwnd,
                             PChar(className),
                             Length(className)));
      SetLength(title, 255);
      //get the process title; usually displayed
      //on the top bar in visible process
      SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
      //Display the process information
      //by adding it to a list box
      SharedMessage := SharedMessage +
        (className +' ;'+//'Class Name = ' +
         title +' ;'+//'; Title = ' +
         IntToStr(hHwnd) +' ;'+ //'; HWND = ' +
         IntToStr(pPid))+' ;'//'; Pid = ' +
         ;//         +#13#10;
      Result := true;
    end;
  end;
begin
if FJobFinished  then
 begin
  try
   FJobFinished := false;
  //define the tag flag
   lp := 0; //globally declared integer
  //call the windows function with the address
  //of handling function and show an error message if it fails
  SharedMessage := '';
  if EnumWindows(@EnumProcess,lp) = false then
   begin
      ErrsMess := SysErrorMessage(GetLastError);
      Synchronize(DoShowErrors);
   end
   else
    Synchronize(DoShowData);
   FJobFinished := true;
  Except on e:Exception do
   OutputDebugString(Pchar('TProcesses.Execute '+e.Message));
  end;
 end
end;

procedure TProcesses.OverrideOnTerminate(Sender: TObject);
begin
 FTimer.Enabled := false;
 FreeAndNil(FTimer);
end;

procedure TProcesses.OverrideOnTimer(Sender: TObject);
begin
  Self.Execute;
end;

end.

Answer 1

我永远不会在线程中使用计时器。WaitForSingleObject相反，我会创建一个系统事件并在线程的执行循环中使用该函数等待它指定的时间。此函数一直等待，直到指定对象（在本例中为事件）处于信号状态或超时间隔过去。

原理很简单，您将在非信号状态下创建事件并将其保持在该状态，直到线程将被终止。这将导致WaitForSingleObject函数每次在函数调用中指定的时间内阻塞线程执行循环时都会超时。一旦您决定终止线程，您只需设置线程的终止标志（您应该尽可能多地询问）并将该事件设置为信号状态，从而导致WaitForSingleObject函数立即返回。

这是一个模拟线程计时器的示例（2秒间隔= 2000ms用作WaitForSingleObject函数调用中的第二个参数）：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TTimerThread = class(TThread)
  private
    FTickEvent: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    procedure FinishThreadExecution;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FTimerThread: TTimerThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
  FTimerThread := TTimerThread.Create(False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FTimerThread.FinishThreadExecution;
end;

{ TTimerThread }

constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
  inherited;
  FreeOnTerminate := True;
  FTickEvent := CreateEvent(nil, True, False, nil);
end;

destructor TTimerThread.Destroy;
begin
  CloseHandle(FTickEvent);
  inherited;
end;

procedure TTimerThread.FinishThreadExecution;
begin
  Terminate;
  SetEvent(FTickEvent);
end;

procedure TTimerThread.Execute;
begin
  while not Terminated do
  begin
    if WaitForSingleObject(FTickEvent, 2000) = WAIT_TIMEOUT then
    begin
      Synchronize(procedure
        begin
          Form1.Tag := Form1.Tag + 1;
          Form1.Caption := IntToStr(Form1.Tag);
        end
      );
    end;
  end;
end;

end.

Answer 2

TTimer不是线程安全的。时期。甚至不要尝试将它与工作线程一起使用。

您TTimer在工作线程的构造函数中实例化 ，这意味着它是在创建工作线程的线程的上下文中实例化的，而不是工作线程本身的上下文。这也意味着计时器将在同一个线程上下文中运行，并且OnTimer不会在工作线程的上下文中触发事件处理程序（如果有的话），因此您的OnTimer处理程序的主体需要是线程安全的。

要TTimer.OnTimer在工作线程的上下文中触发事件，您必须实例化TTimer线程内部的Execute()方法。但这还有另一组陷阱。 TTimer使用 创建一个隐藏窗口AllocateHWnd()，它不是线程安全的，不能在主线程的上下文之外安全地使用。此外，TTimer要求创建线程上下文具有活动的消息循环，而您的线程没有。

要执行您正在尝试的操作，您需要直接切换到使用 Win32 APISetTimer()函数（这允许您绕过对窗口的需要），然后将消息循环添加到您的线程（无论您是否使用窗口，您仍然需要它或不），否则切换到不同的计时机制。CreateWaitableTimer()您可以通过and使用等待计时器WaitForSingleObject()，在这种情况下，您不需要窗口或消息循环。或者您可以使用多媒体计时器timeSetEvent()（只需确保您的多媒体计时器回调是线程安全的，因为计时器将在自己的线程中运行）。

Answer 3

首先，在构造函数 TProcesses.Create(aGrid : TJvStringGrid); 你有：

FTimer.OnTimer := OverrideOnTerminate;
FTimer.OnTimer := OverrideOnTimer;

这里 OverrideOnTerminate 永远不会触发。可能您想捕获线程 OnTerminate。

其次，您在运行状态下创建线程继承 Create(false); 所以 Execute 被自动调用。当 Execute 完成时，它调用 DoTerminate 并销毁线程。

接下来，当计时器触发 OnTimer 时，您多次调用 Execute；这里的线程可能已经不存在。定时器没有被释放，你尝试启动一个死线程。

您需要按照一些规则重写代码：

1. Execute 应该连续运行。您可以使用 WaitForSingleObject/WaitForMultipleObjects 将线程置于“睡眠”状态。查看 MSDN 帮助。
2. 这些函数有 Timeout 参数，所以你根本不需要 TTimer。

[编辑] 我为你找到了一些有用的样本（对不起，我没有测试过）：

procedure TProcesses.Execute;
const  
 _SECOND = 10000000;  
var  
 lBusy : LongInt;  
 hTimer : LongInt;  
 liWaitTime : LARGE_INTEGER;  
begin  
  hTimer := CreateWaitableTimer(nil, True, 'WaitableTimer');
  liWaitTime.QuadPart := _SECOND * YOUR_NumberOfSeconds;
  SetWaitableTimer(hTimer, TLargeInteger(liWaitTime ), 0, nil, nil, False);  
  repeat  
    lBusy := MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT);
    // CODE EXECUTED HERE EVERY YOUR_NumberOfSeconds
   Until lBusy = WAIT_OBJECT_0;  
   CloseHandle(hTimer);  
end;  

你需要稍微调整一下。添加一个要等待的对象：使用 CreateEvent 函数创建的事件。当您需要立即终止线程时，只需调用 SetEvent 函数。

Answer 4

你能检查计时器是真正属于新线程（TProcess）还是主线程？窗口中的计时器由线程“拥有”（就资源管理器而言），而不是进程。如果你的计时器归主线程所有，那么 OnTimer 事件将在主线程的上下文中运行，即使你显式调用 Execute，调用仍将在主线程的上下文中，无论 Execute 是否为恰好是 TThread 后代的“对象过程”。

而且你可能不会明确地调用 Execute 。当线程运行时（在新线程的上下文中）调用此过程。

最好试试这个：在 Execute 中，使用 windows api 函数创建计时器，并无限等待 (SleepEx) 并将 alertable 参数设置为 TRUE。然后计时器确实会在新线程的上下文中触发。或者，在 OnTimer 事件中（在主线程的上下文中），您可以将 APC 过程调用发布到工作线程（您仍然需要在 SleepEx 中等待并将 alertable 设置为 TRUE）。一个完全不同的选择：在 OnTimer 事件中创建线程对象并在 Execute 内部进行正常处理 - FreeOnTerminate 应设置为 true，以便在完成后释放对象。

最后一点，我不确定您是否可以将该 EnumProcess 函数（在“对象过程”中声明的函数???）传递给 WinApi 调用。这很可能导致崩溃。我认为您需要在全局级别声明的函数。

Answer 5

谢谢@TLama，多年后它对我有帮助。我将代码转换为 Delphi 7，也许它可以帮助某人。只需复制并粘贴新应用程序，然后双击 Form1 -> Inspector -> 事件：OnCreate 和 OnDestroy。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TTimerThread = class(TThread)
  private
    FTickEvent: THandle;
    procedure ProcessGUI;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    procedure FinishThreadExecution;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FTimerThread: TTimerThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption := 'Init...';//IntToStr(Form1.Tag);
  FTimerThread := TTimerThread.Create(False);
  Form1.Caption := IntToStr(Form1.Tag);
  Form1.Repaint;
  Application.ProcessMessages;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FTimerThread.FinishThreadExecution;
end;

{ TTimerThread }

constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
  inherited;
  FreeOnTerminate := True;
  FTickEvent := CreateEvent(nil, True, False, nil);
end;

destructor TTimerThread.Destroy;
begin
  CloseHandle(FTickEvent);
  inherited;
end;

procedure TTimerThread.FinishThreadExecution;
begin
  Terminate;
  SetEvent(FTickEvent);
end;

procedure TTimerThread.Execute;
begin
  while not Terminated do
  begin
    if WaitForSingleObject(FTickEvent, 3000) = WAIT_TIMEOUT then
    begin
      Synchronize(ProcessGUI);
    end;
  end;
end;

procedure TTimerThread.ProcessGUI;
begin
  Form1.Tag := Form1.Tag + 3;
  Form1.Caption := IntToStr(Form1.Tag);
end;

end.

Answer 6

您的线程正在处理 GUI 控件（假设 TJvStringGrid 是一个 GUI 控件）。这绝不是一个好主意，并且会产生意想不到的结果。没有其他线程，然后主线程应该接触 GUI 的东西。