如何停止在 Delphi 中使用 IVBSAXXMLReader 解析 XML 文档？

Posted 2023-02-25

【中文标题】如何停止在 Delphi 中使用 IVBSAXXMLReader 解析 XML 文档？

【英文标题】：How do I stop parsing an XML document with IVBSAXXMLReader in Delphi?

【发布时间】：2016-12-23 20:18:57

【问题描述】：

为了在一个 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 “灾难性故障”。 （我也尝试过引发自定义异常，结果相同。）

MSDN 说如下：

ErrorHandler 接口本质上允许 XMLReader 向 ContentHandler 实现发出它想要中止处理的信号。相反，ContentHandler 实现可以向 XMLReader 指示它想要中止处理。这可以通过简单地引发特定于应用程序的异常来完成。一旦实现找到它正在寻找的内容，这对于中止处理特别有用：

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"。

所以，现在我没有想法了：

我需要在错误处理程序接口中实现一些特殊的东西吗？ 我是否需要引发特定异常而不是 EAbort？ 还是我错过了什么？

---

编辑：

根据 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 类添加两个新字段：

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 属性。所以，如果有更多的属性/字段，例如

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

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

好处是你会在调试器中得到正确的异常地址。请注意，您不会得到正确的调用堆栈。

【问题讨论】：

您应该将您的编辑更改为实际答案。将其发布在问题本身并不合适，并且以完整答案的形式对未来的读者更有用。 （它也会给你一些投票，因为它写得很好；作为一个实际的答案发布并稍微充实肯定值得一些支持。）

【参考方案1】：

只需拨打Abort; 即可。在这种情况下，只需在 IVBSAXContentHandler 实现类中覆盖 SafeCallException：

function TContentHandler.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HRESULT;
begin
  Result := HandleSafeCallException(ExceptObject, ExceptAddr, TGUID.Empty, '', '');
end;

在ComObj 中提供的HandleSafeCallException 将导致您提出的EAbort 转换为HRESULT 值E_ABORT，然后将由SafeCallError 转换回EAbort。

或者，您可以提出自己的异常类，覆盖 SafeCallException 以将其转换为特定的 HRESULT 值并用您自己的替换 SafeCallErrorProc 以将其转换回您的 Delphi 异常，然后您可以在调用方。

【讨论】：

@DavidHeffernan 他们会这样做，但仅限于TComObject，当您实现完整的 COM 对象时，这通常是基类。可能他们已经在TComObject 和TInterfacedObject 之间添加了默认的EAbort 处理，并且仍然让后者独立于COM，我不确定。

显然 HandleSafeCallException（在 ComObj 单元中声明，以防万一其他人想知道）不会返回 E_ABORT 如果 exceptObject 是 EAbort（至少在 Delphi 2007 中不是），所以我必须自己更改它。但是感谢您为我指明了这个方向。

@dummzeuch 抱歉，我手头没有 D2007。我正在使用XE7。不过，很高兴您设法解决了问题。

@OndrejKelle 我没有在抱怨，只是向其他可能会在以后遇到此答案的人提供提示。哦，TGUID.Empty 在 Delphi 2007 中不存在。相反，我们需要一个用全零初始化的 TGUID 记录，例如ZeroMemory(@GUIDRec, SizeOf(GUIDRec))

@dummzeuch 感谢您的提示。我认为最好的办法是清理答案，稍后当我回到安装了 D2007 的计算机时，我会这样做。