Delphi - timer inside thread generates AV

Question

I have the following thread code which executes correct first time. After that from time to time I get an AV on the Execute method of the thread, eg

Debug Output: TProcesses.Execute Access violation at address 00409C8C in module 'ListenOutputDebugString.exe'. Read of address 08070610 Process ListenOutputDebugString.exe (740)

I don't know what is generating this 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

I would never use timer in a thread. Instead I would create a system event and wait for it in the thread's execution loop for a specified time with the WaitForSingleObject function. This function waits until the specified object (in this case the event) is in the signalled state or the time-out interval elapses.

The principle is easy, you'll create the event in the non-signalled state and keep it in that state until the thread is going to be terminated. This will result the WaitForSingleObject function to timeout every time what blocks your thread execution loop for the time specified in the function call. Once you'll decide to terminate your thread you just set the thread's termination flag (on which you should ask as much as you can) and set that event to the signalled state what causes the WaitForSingleObject function to return immediately.

Here is an example which simulates a thread timer (with 2 seconds interval = 2000ms used as a second parameter in WaitForSingleObject function calls):

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 is not thread-safe. Period. Don't even try to use it with a worker thread.

You are instantiating the TTimer in the worker thread's constructor, which means that it being instantiated in the context of the thread that is creating the worker thread, not the context of the worker thread itself. That also means that the timer will run in that same thread context and the OnTimer event andler will not be triggered in the context of the worker thread (if at all), so the body of your OnTimer handler needs to be thread-safe.

To have the TTimer.OnTimer event be triggered in the context of the worker thread, you have to instantiate the TTimer inside the thread's Execute() method instead. But that has another set of pitfalls. TTimer creates a hidden window using AllocateHWnd() , which is not thread-safe and cannot safely be used outside the context of the main thread. Also, TTimer requires the creating thread context to have an active message loop, which your thread does not.

To do what you are attempting, you need to either switch to using the Win32 API SetTimer() function directly (which allows you to bypass the need for a window) and then add a message loop to your thread (which you still need whether you use a window or not), or else switch to a different timing mechanism. You could use a waitable timer via CreateWaitableTimer() and WaitForSingleObject() , i which case you don't need a window or a message loopp. Or you can use a multimedia timer via timeSetEvent() (just make sure your multimedia timer callback is thread-safe because the timer will run in its own thread).

Answer 3

First, in constructor TProcesses.Create(aGrid : TJvStringGrid); you have:

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

Here OverrideOnTerminate never fires. Probably you want to catch thread OnTerminate.

Second, you create thread in running state inherited Create(false); so Execute is called automatically. When Execute is finished it calls DoTerminate and thread is destroyed.

Next, when timer fire OnTimer you call multiple times Execute; Here Thread already may not exists. Timer is not freed, and you try to start a dead thread.

You need to rewrite your code following some rules:

1. Execute should run continuously. You may put thread to "sleep" using WaitForSingleObject/WaitForMultipleObjects. Take a look at MSDN help.
2. These functions have Timeout parameter, so you don't need TTimer at all.

[EDIT] I found some useful sample for you (sorry, it's not tested by me):

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;  

You need to slightly adjust this. Add one more object to wait for: an event created with CreateEvent function. When you need to instantly terminate thread just call SetEvent function.

Answer 4

Can you check if the timer is really owned by the new thread (TProcess) or by the main one? Timers in windows are "owned" (in terms of the resource manager) by threads, not processes. If your timer is owned by the main thread then the OnTimer event will be running in the context of the main thread, and even if you explicitly call Execute, the call will still be in the context of the main thread, no matter if Execute is a "procedure of object" which happens to be a TThread descendant.

And you may not explicitly call Execute anyway. This procedure is called (in the context of the new thread) when the thread runs.

Better try this: Inside Execute, create the timer using the windows api functions, and wait infinitely (SleepEx) with the alertable parameter set to TRUE. Then the timer will indeed be firing in the context of the new thread. Alternatively in the OnTimer event (in the context of the main thread) you can be posting APC procedure calls to the worker thread (you will still need to wait in SleepEx and set alertable to TRUE). A completely different alternative: in the OnTimer event create the thread object and do the normal processing inside Execute - FreeOnTerminate should be set to true so that the object is freed after finishing.

And one final note, I'm not sure if you can pass that EnumProcess function (a function declared inside a "procedure of object" ???) to a WinApi call. This may well be causing the crashes. I think you need a function declared at global level.

Answer 5

Your thread is working on GUI controls (Assuming TJvStringGrid is a GUI control). That is never a good idea and can give unexpected results. No other thread then the main thread should touch GUI stuff.

Answer 6

Thanks @TLama, it help me many year later. I converted the code to Delphi 7, maybe it helps someone. Just copy and past on new application and double click on Form1 -> Inspector -> Events: OnCreate and 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.