multithreading - Delphi - 线程内定时器生成AV

Question

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

Debug Output: TProcesses.Execute Access violation at address 00409C8C in module 'ListenOutputDebugString.exe'. Read of address 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 秒间隔 = 2000 毫秒用作 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.