Delphi 捕获异步 ADOQuery 异常

Question

我正在异步打开 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;

Answer 1

在异步模式下，您可以在 OnExecuteComplete event handler of your 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;

Delphi 捕获异步 ADOQuery 异常

Delphi catch Async ADOQuery Exception

delphi

multithreading

ado