当准备关闭窗体时,如果线程仍在运行,那么您发出信号终止它,但您不等待它完全终止,然后在窗体实际关闭时显式销毁线程对象,即使您使用的是FreeOnTerminate=True。
您应该在显式销毁线程对象之前调用TThread.WaitFor(),但是在使用FreeOnTerminate=True 时这不起作用,这会导致您看到的那种错误。除此之外,如果线程仍在运行,TThread 析构函数会在自身上调用WaitFor(),并且您正在显式销毁线程对象。所以无论哪种方式,你都会导致错误。
所以,您需要:
我还建议覆盖线程的虚拟TerminatedSet() 方法以设置一个标志,然后可以在线程内部检查该标志以中止GET 请求,例如在TIdHTTP.OnWork 事件中。
在使用FreeOnTerminated=True 时尝试这样的操作:
type
TLoadListThread = class(TThread)
private
FUrl: string;
FOnLoading: TNotifyEvent;
DoAbort: Boolean;
procedure CheckAbort;
procedure DoLoading;
procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
protected
procedure TerminatedSet; override;
public
constructor Create(const AUrl: String);
property OnLoading: TNotifyEvent read FOnLoading write FOnLoading;
end;
constructor TLoadListThread.Create(const AUrl: String);
begin
inherited Create(True);
FreeOnTerminate := True;
FUrl := AUrl;
end;
procedure TLoadListThread.CheckAbort;
begin
if DoAbort then SysUtils.Abort;
end;
procedure TLoadListThread.DoLoading;
begin
if Assigned(FOnLoading) then FOnLoading(Self);
end;
procedure TLoadListThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
CheckAbort;
end;
procedure TLoadListThread.TerminatedSet;
begin
inherited;
DoAbort := True;
end;
procedure TLoadListThread.Execute;
var
HTTP: TIdHTTP;
begin
HTTP := TIdHTTP.Create;
try
st := TStringList.Create;
try
ms := TMemoryStream.Create;
try
if Assigned(FOnLoading) then Synchronize(DoLoading);
CheckAbort;
HTTP.Get(FUrl, ms);
ms.Position := 0;
st.LoadFromStream(ms, TEncoding.UTF8);
finally
ms.Free;
end;
CheckAbort;
// Do something with st
finally
st.Free;
end;
finally
HTTP.Free;
end;
end;
private
procedure CloseOnTerminated(Sender: TObject);
procedure TForm58.FormShow(Sender: TObject);
begin
StopLoadListThread;
LListThread := TLoadListThread.Create(urlserver);
LListThread.OnLoading := LoadListThreadLoading;
LListThread.OnTerminate := LoadListThreadFinished;
LListThread.Start;
end;
procedure TForm58.StopLoadListThread;
begin
if Assigned(LListThread) then
begin
LListThread.OnLoading := nil;
LListThread.OnTerminate := nil;
LListThread.Terminate;
LListThread := nil;
end;
end;
procedure TForm58.LoadListThreadLoading(Sender: TObject);
begin
Label1.Text := 'Loading...';
end;
procedure TForm58.LoadListThreadFinished(Sender: TObject);
begin
if LListThread.FatalException = nil then
// Do something
else
// Do something else
LListThread := nil;
end;
procedure TForm58.CloseOnTerminated(Sender: TObject);
begin
LListThread := nil;
Close;
end;
procedure TForm58.CloseButtonClick(Sender: TObject);
begin
Close;
end;
procedure TForm58.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(LListThread) then
begin
LListThread.OnTerminate := CloseOnTerminated;
LListThread.Terminate;
Action := TCloseAction.caNone;
end
else
begin
// Do something
Action := TCloseAction.caFree;
end;
end;
或者这个,当使用FreeOnTerminated=False时:
type
TLoadListThread = class(TThread)
private
FUrl: string;
FOnLoading: TNotifyEvent;
DoAbort: Boolean;
procedure CheckAbort;
procedure DoLoading;
procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
protected
procedure TerminatedSet; override;
public
constructor Create(const AUrl: String);
property OnLoading: TNotifyEvent read FOnLoading write FOnLoading;
end;
constructor TLoadListThread.Create(const AUrl: String);
begin
inherited Create(True);
FreeOnTerminate := False;
FUrl := AUrl;
end;
procedure TLoadListThread.CheckAbort;
begin
if DoAbort then SysUtils.Abort;
end;
procedure TLoadListThread.DoLoading;
begin
if Assigned(FOnLoading) then FOnLoading(Self);
end;
procedure TLoadListThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
CheckAbort;
end;
procedure TLoadListThread.TerminatedSet;
begin
inherited;
DoAbort := True;
end;
procedure TLoadListThread.Execute;
var
HTTP: TIdHTTP;
begin
HTTP := TIdHTTP.Create;
try
st := TStringList.Create;
try
ms := TMemoryStream.Create;
try
if Assigned(FOnLoading) then Synchronize(DoLoading);
CheckAbort;
HTTP.Get(FUrl, ms);
ms.Position := 0;
st.LoadFromStream(ms, TEncoding.UTF8);
finally
ms.Free;
end;
CheckAbort;
// Do something with st
finally
st.Free;
end;
finally
HTTP.Free;
end;
end;
procedure TForm58.FormShow(Sender: TObject);
begin
StopLoadListThread;
LListThread := TLoadListThread.Create(urlserver);
LListThread.OnLoading := LoadListThreadLoading;
LListThread.OnTerminate := LoadListThreadFinished;
LListThread.Start;
end;
procedure TForm58.StopLoadListThread;
begin
if Assigned(LListThread) then
begin
LListThread.OnLoading := nil;
LListThread.OnTerminate := nil;
LListThread.Terminate;
LListThread.WaitFor;
FreeAndNil(LListThread);
end;
end;
procedure TForm58.LoadListThreadLoading(Sender: TObject);
begin
Label1.Text := 'Loading...';
end;
procedure TForm58.LoadListThreadFinished(Sender: TObject);
var
Thread: TThread;
begin
Thread := TThread(Sender);
if Thread.FatalException = nil then
// Do something
else
// Do something else
// if using 10.1 Berlin or earlier:
TThread.CreateAnonymousThread(
procedure
begin
TThread.Queue(nil,
procedure
begin
Thread.Free;
end
);
end;
).Start;
// if using 10.2 Tokyo or later:
TThread.ForceQueue(nil,
procedure
begin
Thread.Free;
end
);
end;
procedure TForm58.CloseButtonClick(Sender: TObject);
begin
Close;
end;
procedure TForm58.FormClose(Sender: TObject; var Action: TCloseAction);
begin
StopLoadListThread;
// Do something
Action := TCloseAction.caFree;
end;