我有以下第一次执行正确的线程代码。之后，我不时在线程的Execute方法上获得AV，例如
调试输出：TProcesses.Execute地址00409C8C的访问冲突 在模块'ListenOutputDebugString.exe'中。读取地址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.
答案 0 :(得分：33)
我永远不会在线程中使用计时器。相反，我会创建一个系统事件，并在线程的执行循环中使用WaitForSingleObject函数等待指定的时间。此函数等待，直到指定的对象（在本例中为事件）处于信号状态或超时间隔过去。
原理很简单，您将在非信号状态下创建事件并将其保持在该状态，直到线程将被终止。这将导致WaitForSingleObject函数每次在函数调用中指定的时间内阻塞线程执行循环时超时。一旦你决定终止你的线程，你只需设置线程的终止标志（你应该尽可能多地询问）并将该事件设置为信号状态导致WaitForSingleObject函数立即返回的原因。 / p>
这是一个模拟线程计时器的示例（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.
答案 1 :(得分：5)
TTimer不是线程安全的。期。甚至不要尝试将它与工作线程一起使用。
您正在实现工作线程的构造函数中的TTimer，这意味着它在创建工作线程的线程的上下文中实例化，而不是工作线程本身的上下文。这也意味着计时器将在同一个线程上下文中运行，OnTimer事件管理器将不会在工作线程的上下文中触发（如果有的话），因此OnTimer处理程序的主体需要是线程安全的。
要在工作线程的上下文中触发TTimer.OnTimer事件，您必须在线程的TTimer方法中实例化Execute()。但这有另一套陷阱。 TTimer使用AllocateHWnd()创建一个隐藏窗口，它不是线程安全的，不能安全地在主线程的上下文之外使用。此外，TTimer要求创建线程上下文具有活动消息循环，而您的线程不会。
要执行您正在尝试的操作，您需要直接切换到使用Win32 API SetTimer()函数（这允许您绕过窗口的需要），然后向您的线程添加一个消息循环（您仍然需要使用窗口，或者切换到不同的计时机制。您可以通过CreateWaitableTimer()和WaitForSingleObject()使用可等待的计时器，在这种情况下，您不需要窗口或消息循环。或者您可以通过timeSetEvent()使用多媒体计时器（只需确保您的多媒体计时器回调是线程安全的，因为计时器将在其自己的线程中运行）。
答案 2 :(得分：1)
首先，在构造函数TProcesses.Create（aGrid：TJvStringGrid）中;你有：
FTimer.OnTimer := OverrideOnTerminate;
FTimer.OnTimer := OverrideOnTimer;
这里OverrideOnTerminate永远不会触发。可能你想要捕获线程OnTerminate。
其次，你创建线程在运行状态下继承Create（false）;所以执行是自动调用的。执行完成后，它调用DoTerminate并销毁线程。
接下来，当计时器触发OnTimer时，你多次调用Execute;这里Thread可能不存在。计时器未被释放，并且您尝试启动死线程。
您需要按照一些规则重写代码：
[编辑] 我找到了一些有用的样品（对不起，我没有测试过）：
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;
您需要稍微调整一下。再添加一个要等待的对象：使用CreateEvent函数创建的事件。当你需要立即终止线程时，只需调用SetEvent函数。
答案 3 :(得分：1)
您可以检查计时器是否真的由新线程（TProcess）或主线程所拥有？ Windows中的计时器由线程“而不是进程”“拥有”（就资源管理器而言）。如果您的计时器由主线程拥有，那么OnTimer事件将在主线程的上下文中运行，即使您显式调用Execute，该调用仍将位于主线程的上下文中，无论Execute是否为一个“对象程序”恰好是一个TThread后代。
你可能还没有明确地调用Execute。当线程运行时，将调用此过程（在新线程的上下文中）。
最好试试这个：在Execute中，使用windows api函数创建计时器，并在alertable参数设置为TRUE的情况下无限等待（SleepEx）。然后计时器将确实在新线程的上下文中触发。或者在OnTimer事件中（在主线程的上下文中），您可以将APC过程调用发布到工作线程（您仍需要在SleepEx中等待并将alertable设置为TRUE）。一个完全不同的选择：在OnTimer事件中创建线程对象并在Execute中执行正常处理 - FreeOnTerminate应该设置为true，以便在完成后释放对象。
最后一点，我不确定你是否可以将EnumProcess函数（在“对象过程”中声明的函数）传递给WinApi调用。这很可能导致崩溃。我认为你需要一个在全球范围内声明的函数。
答案 4 :(得分：0)
您的线程正在处理GUI控件（假设TJvStringGrid是一个GUI控件）。这绝不是一个好主意，可以给出意想不到的结果。没有其他线程，那么主线程应该触摸GUI的东西。
答案 5 :(得分：0)
谢谢@TLama，很多年后它对我很有帮助。我将代码转换为Delphi 7，也许它可以帮助某人。只需复制并过去新的应用程序，然后双击Form1 - ＆gt;检查员 - ＆gt;事件：OnCreate和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.