如何停止在Delphi中使用IVBSAXXMLReader解析XML文档？
为了快速解析德尔福（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 =“灾难性的失败”叫。 使用空方法体仍然会导致上述无用的EOleException“灾难性故障”。
所以，现在我没有想法：
编辑：
基于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;
虽然这个工作对我来说，它有一个严重的缺陷：它仅复制信息和原始异常的HelpContext属性。 所以，如果有更多的属性/字段，例如
EInOutError = class(Exception)
public
ErrorCode: Integer;
end;
在调用代码中重新生成异常时，这些将不会被初始化。
好处是您将在调试器中获得正确的异常地址。 注意你不会得到正确的调用堆栈。
只需调用Abort; 很好。 在这种情况下，只需要重写SafeCallException在IVBSAXContentHandler实施者类：
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异常，然后在呼叫方处理该异常。
上一篇: How do I stop parsing an XML document with IVBSAXXMLReader in Delphi?