问题描述
我有以下第一次正确执行的线程代码.之后我不时在线程的 Execute 方法上得到一个 AV,例如
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
调试输出:地址 00409C8C 处的 TProcesses.Execute 访问冲突在模块ListenOutputDebugString.exe"中.读取地址 08070610进程 ListenOutputDebugString.exe (740)
我不知道是什么产生了这个 AV...
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.
推荐答案
我绝不会在线程中使用计时器.相反,我会创建一个系统事件并使用 WaitForSingleObject
函数.此函数一直等到指定的对象(在本例中为事件)处于信号状态或超时间隔结束.
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.
原理很简单,您将在无信号状态下创建事件并保持该状态直到线程将被终止.这将导致 WaitForSingleObject
函数在每次在函数调用中指定的时间内阻塞线程执行循环时超时.一旦你决定终止你的线程,你只需设置线程的终止标志(你应该尽可能多地询问它)并将该事件设置为信号状态是什么导致 WaitForSingleObject
函数立即返回.
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.
这是一个模拟线程计时器的示例(以 2 秒间隔 = 2000 毫秒用作 WaitForSingleObject
函数调用):
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.
这篇关于Delphi - 线程内的定时器生成AV的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!