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

Question

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

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

这很好,只要我简单地解析整个文件,但是一旦找到了我要查找的内容,我就想停止.所以我的IVBSAXContentHandler.startElement实现会检查某些条件,当它为true时应该中止进一步的解析.我试过这个:

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);

不幸的是,这没有任何区别,因为现在使用strErrorMessage ='灾难性故障'来调用fatalError处理程序.使用空方法体仍然会导致上述无用的EOleException"灾难性故障".

所以,现在我没有想法:

• 我是否需要在errorhandler接口中实现一些特殊功能？
• 我是否需要提出一个特殊的异常而不是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;

在调用代码中重新引发异常时,不会初始化这些内容.

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

Answer 1

打电话Abort;很好.在这种情况下,只需SafeCallException在您的IVBSAXContentHandler实现者类中重写:

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

HandleSafeCallException在供给ComObj会造成EAbort你提高翻译成一个HRESULT值E_ABORT,然后将被翻译回EAbort用SafeCallError.

或者,您可以引发自己的异常类,覆盖SafeCallException以将其转换为您的特定HRESULT值,并替换为您自己的异常类,将其SafeCallErrorProc转换回您可以在调用端处理的Delphi异常.