Delphi - 计时器内部线程生成AV

Question

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

调试输出:TProcesses.Execute在模块'ListenOutputDebugString.exe'中的地址00409C8C处的访问冲突.读取地址08070610处理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 API SetTimer()函数(这允许你绕过窗口的需要),然后在你的线程中添加一个消息循环(无论你是否使用窗口,你仍然需要它或不),或切换到不同的计时机制.你可以通过使用一个可等待计时器CreateWaitableTimer()和WaitForSingleObject(),我这种情况下,你并不需要一个窗口或消息loopp.或者您可以使用多媒体计时器timeSetEvent()(只需确保您的多媒体计时器回调是线程安全的,因为计时器将在其自己的线程中运行).