如何停止使用 Delphi 中的 IVBSAXXMLReader 解析 XML 文档?

How do I stop parsing an XML document with IVBSAXXMLReader in Delphi?

为了在Delphi (2007) 程序中快速解析一些大型XML 文档,我实现了IVBSAXContentHandler 接口并像这样使用它:

FXMLReader := CoSAXXMLReader60.Create;
FXMLReader.contentHandler := Self;
FXMLReader.parseURL(FXmlFile);

这工作正常,只要我简单地解析整个文件,但我想在找到我要查找的内容后停止。因此,我对 IVBSAXContentHandler.startElement 的实现会检查某些条件,当条件为真时,应该中止进一步的解析。我试过这个:

procedure TContentHandler.startElement(var strNamespaceURI, strLocalName,  strQName: WideString; const oAttributes: IVBSAXAttributes);
begin
  if SomeCondition then
    SysUtils.Abort;
end;

不幸的是,这引发了相当无用的 EOleException "Catastrophic failure"。 (我也尝试引发自定义异常,结果相同。)

MSDN 表示如下:

The ErrorHandler interface essentially allows the XMLReader to signal the ContentHandler implementation that it wants to abort processing. Conversely, ContentHandler implementations can indicate to the XMLReader that it wants to abort processing. This can be accomplished by simply raising an application-specific exception. This is especially useful for aborting processing once the implementation finds what it is looking for:

Private Sub IVBSAXContentHandler_characters(ByVal strChars As String)
' I found what I was looking for, abort processing
  Err.Raise vbObjectError + errDone, "startElement", _
        "I got what I want, let's go play!"
End Sub

所以,显然我还需要以某种方式实现 IVBSAXErrorHandler 接口。该接口需要三个方法:

procedure TContentHandler.error(const oLocator: IVBSAXLocator;
  var strErrorMessage: WideString; nErrorCode: Integer);
begin

end;

procedure TContentHandler.fatalError(const oLocator: IVBSAXLocator;
  var strErrorMessage: WideString; nErrorCode: Integer);
begin

end;

procedure TContentHandler.ignorableWarning(const oLocator: IVBSAXLocator;
  var strErrorMessage: WideString; nErrorCode: Integer);
begin

end;

并且还必须在调用 ParseURL 方法之前赋值:

FXMLReader := CoSAXXMLReader60.Create;
FXMLReader.contentHandler := Self;
FXMLReader.errorHandler := Self;
FXMLReader.parseURL(FXmlFile);

不幸的是,这没有任何区别,因为现在 fatalError 处理程序通过 strErrorMessage = 'Catastrophic failure' 被调用。对于空方法体,这仍然会导致上述无用的 EOleException "Catastrophic failure".

所以,现在我没主意了:


编辑:

根据 Ondrej Kelle 的回答,这是我最终使用的解决方案:

声明以下常量:

const
  // idea taken from Delphi 10.1 unit System.Win.ComObj:
  EExceptionRaisedHRESULT = HResult(E_UNEXPECTED or (1 shl 29)); // turn on customer bit

向 TContentHandler 添加两个新字段 class:

FExceptObject: TObject;
FExceptAddr: Pointer;

将此代码添加到析构函数中:

FreeAndNil(FExceptObject);

添加新方法 SafeCallException:

function TContentHandler.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
var
  GUID: TGUID;
  exc: Exception;
begin
  if ExceptObject is Exception then begin
    exc := Exception(ExceptObject);
    // Create a copy of the exception object and store it in the FExceptObject field
    FExceptObject := exc.NewInstance;
    Exception(FExceptObject).Create(exc.Message);
    Exception(FExceptObject).HelpContext := exc.HelpContext;
    // Store the exception address in the FExceptAddr field
    FExceptAddr := ExceptAddr;
    // return a custom HRESULT
    Result := EExceptionRaisedHRESULT;
  end else begin
    ZeroMemory(@GUID, SizeOf(GUID));
    Result := HandleSafeCallException(ExceptObject, ExceptAddr, GUID, '', '');
  end;
end;

向调用代码添加异常处理程序:

var
  exc: Exception;
begin
  try
    FXMLReader := CoSAXXMLReader60.Create;
    FXMLReader.contentHandler := Self;
    // we do not need an errorHandler
    FXMLReader.parseURL(FXmlFile);
    FXMLReader := nil;
  except
    on e: EOleException do begin
      // Check for the custom HRESULT
      if e.ErrorCode = EExceptionRaisedHRESULT then begin
        // Check that the exception object is assigned
        if Assigned(FExceptObject) then begin
          exc := Exception(FExceptObject);
          // set the pointer to NIL
          FExceptObject := nil;
          // raise the exception a the given address
          raise exc at FExceptAddr;
        end;
      end;
      // fallback: raise the original exception
      raise;
    end;
  end;
end;

虽然这对我有用,但它有一个严重的缺陷:它只复制原始异常的 Message 和 HelpContext 属性。所以,如果有更多 properties/fields,例如

EInOutError = class(Exception)
public
  ErrorCode: Integer;
end;

当在调用代码中重新引发异常时,这些将不会被初始化。

优点是您将在调试器中获得正确的异常地址。请注意,您将无法获得正确的调用堆栈。

直接调用Abort;即可。在这种情况下,只需在 IVBSAXContentHandler 实现者 class:

中覆盖 SafeCallException
function TContentHandler.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HRESULT;
begin
  Result := HandleSafeCallException(ExceptObject, ExceptAddr, TGUID.Empty, '', '');
end;
ComObj 中提供的

HandleSafeCallException 将导致 EAbort 你提出的被翻译成 HRESULTE_ABORT 然后将被翻译回来通过 SafeCallError.

EAbort

或者,您可以提出自己的异常 class,覆盖 SafeCallException 以将其转换为您的特定 HRESULT 值并将 SafeCallErrorProc 替换为您自己的以进行转换回到您的 Delphi 异常,然后您可以在调用方处理该异常。