我异步打开ADOQuery,它按预期工作,但任何异常都会导致应用程序挂起。异常不会传递回主线程。
procedure TfrmMain.actRunExecute(Sender: TObject);
begin
ReportOpening := true;
with myADOQuery do begin
ExecuteOptions := [eoAsyncExecute, eoAsyncFetch, eoAsyncFetchNonBlocking];
OnFetchProgress := ADOQueryFetchProgress;
OnFetchComplete := ADOQueryFetchComplete;
try
Open;
except
on E: Exception do MessageDlg(E.Message, mtError, [mbOK], 0); //I expect a timeout here
end;
end;
end;
procedure TfrmMain.ADOQueryFetchComplete(DataSet: TCustomADODataSet; const Error: Error; var EventStatus: TEventStatus);
begin
ReportOpening := false;
end;
procedure TfrmMain.ADOQueryFetchProgress(DataSet: TCustomADODataSet; Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
begin
TThread.Synchronize(nil, procedure()
begin
StatusBar1.Panels[1].Text := Format('Progress: %d of %d',[Progress, MaxProgress]);
end;
);
Application.ProcessMessages;
end;
在异步模式下,您可以捕获OnExecuteComplete
对象的TADOConnection
事件处理程序中的错误。您可以使用EventStatus
和Error
对象来确定是否存在问题。 Error.Description
将为您提供数据库服务器返回的错误。
P.S。:请不要在您的代码中使用Application.ProcessMessages
,因为您使用的是异步查询,因此它可能会导致无法预料的事件再入场景。
例:
procedure TForm1.ADOConnection1ExecuteComplete(Connection: TADOConnection; RecordsAffected: Integer; const Error: Error;
var EventStatus: TEventStatus; const Command: _Command; const Recordset: _Recordset);
begin
if EventStatus = esErrorsOccured then
begin
memo1.Lines.add(Error.Description);
// recover from error here
end;
end;