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, e.g
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.
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With