Delphi7调用Microsoft WebService.dll实现XML规范化遇阻求助

我正在修改一个Delphi7旧项目，需要添加证书与签名功能。调研后选用微软WebService.dll中的XML规范化函数：WsStartReaderCanonicalization/WsEndReaderCanonicalization、WsStartWriterCanonicalization/WsEndWriterCanonicalization。已找到对应的Delphi头文件翻译，但调用时遇到以下问题：

• 调用WsMoveReader()时报错；
• 删除WsMoveReader()调用后，代码无报错，但回调函数MyCallback的buffer参数始终为nil。

测试代码如下：

{$APPTYPE CONSOLE}
program XmlBufferExample;

//This example shows some use of the xml buffer APIs.
//Original C++ code from Microsoft :
//https://msdn.microsoft.com/en-us/library/windows/desktop/dd819131(v=vs.85).aspx

uses
  Windows, Sysutils, Classes,
  webservices in 'webservices.pas';

Procedure PrintError(errorCode:HRESULT; error:PWS_ERROR);
var
  hr:HRESULT;
  errorCount,i:ULONG;
  str:WS_STRING;
  s:string;
begin
  writeln(Format('Failure: errorCode=0x8%.x',[errorCode]));

  if (errorCode=E_INVALIDARG) or (errorCode=WS_E_INVALID_OPERATION) then
  begin
    // Correct use of the APIs should never generate these errors
    writeln('The error was due to an invalid use of an API. This is likely due to a bug in the program.');
    exit;
  end;

  hr:=NOERROR;
  if (error<>nil) then
  begin
    hr:=WsGetErrorProperty(error, WS_ERROR_PROPERTY_STRING_COUNT, @errorCount, sizeof(errorCount));
    if (hr=NOERROR) and (errorCount>0) then
      for i:=0 to errorCount-1 do
      begin
        hr:=WsGetErrorString(error, i, @str);
        if (hr=NOERROR) then
        begin
          s:=copy(str.chars,1,str.length);
          writeln(s);
        end else
          errorCount:=i; //exit for
      end;
  end;
  if (hr<>NOERROR) then
    writeln(Format('Could not get error string (errorCode=0x8%.x)',[hr]));
end;

var
  MyCallbackStatus : Cardinal;
  Found : BOOL;
  Mybuffer:PWS_XML_BUFFER = nil;
const
  HeapSize = 24 * 1024;  //24 kb

function MyCallback(callbackState : pointer; buffer : PWS_BYTES; count : ULONG;
                     asyncContext : PWS_ASYNC_CONTEXT; error : PWS_ERROR):HRESULT; stdcall;
var
  S : AnsiString;
begin
//debuging start
  Writeln('Inside MyCallback :');
  Writeln('MyCallbackStatus :', IntToStr(MyCallbackStatus));
  if Assigned(error) then PrintError(0, error);
//debuging end

  if Assigned(buffer) then
    SetString(S, PAnsiChar(buffer.bytes), buffer.length);

  Writeln(s);
end;

var
  hr:HRESULT;
  error:PWS_ERROR;
  heap:PWS_HEAP;
  buffer:PWS_XML_BUFFER;
  writer:PWS_XML_WRITER;
  reader:PWS_XML_READER;
  newXml:pointer;
  newXmlLength:ULONG;
  xml:ansistring;
  ExitCode:integer;
  Stream : TMemoryStream;
begin
  error:=nil;
  heap:=nil;
  buffer:=nil;
  writer:=nil;
  reader:=nil;
  newXml:=nil;
  newXmlLength:=0;

  // Create an error object for storing rich error information
  hr := WsCreateError(nil,
                      0,
                      @error);

  if (hr=NOERROR) then
  begin
    // Create a heap to store deserialized data
    hr := WsCreateHeap(2048,   //maxSize
                       512,    //trimSize
                       nil,
                       0,
                       @heap,
                       error);
  end;

  if hr=NOERROR then
  begin
    // Create an XML writer
    hr := WsCreateWriter(nil,
                         0,
                         @writer,
                         error);
  end;

  if hr=NOERROR then
  begin
    // Create an XML reader
    hr := WsCreateReader(nil,
                         0,
                         @reader,
                         error);
  end;

  // Some xml to read and write
  xml:='<a><b>1</b><c>2</c></a>';

  if hr=NOERROR then
  begin
    hr:=WsReadXmlBufferFromBytes(reader,
                                 nil,
                                 nil,
                                 0,
                                 PAnsiChar(xml), //@xml[1],
                                 length(xml),
                                 heap,
                                 @buffer,
                                 error);

  end;

  if hr=NOERROR then
  begin
    hr:=WsWriteXmlBufferToBytes(writer,
                                buffer,
                                nil,
                                nil,
                                0,
                                heap,
                                @newXml,
                                @newXmlLength,
                                error);
  end;

  if hr=NOERROR then
  begin
    writeln('new xml :');
    writeln(copy(PAnsiChar(newXml),1,newXmlLength));
    writeln;
    ExitCode:=0;
  end;

  //----------------------------------------
  //My test start
  //----------------------------------------
  if hr=NOERROR then
  begin
    if Assigned(reader) then
    begin
      WsFreeReader(reader);
      reader := nil;
    end;
    hr := WsCreateReader(nil, 0, @reader, error);

    if Assigned(heap) then
    begin
      WsFreeHeap(heap);
      heap := nil;
    end;
    hr := WsCreateHeap(3 * HeapSize, 512, nil, 0, @heap, error);

    if hr=NOERROR then
    begin
      //load xml file
      Stream := TMemoryStream.Create();
      try
        Stream.LoadFromFile('Z:\zatca-einvoicing-sdk\test\100030.xml');
        SetString(xml, PChar(Stream.Memory), Stream.Size);
        Writeln;
        Writeln('-------------------------------');
        Writeln('XML File size is ' + IntToStr(Stream.Size) + ' Bytes');
      finally
        Stream.Free();
      end;

      hr:=WsReadXmlBufferFromBytes(reader, nil, nil, 0, PAnsiChar(xml), length(xml), heap, @buffer, error);
    end;

(*
according to https://learn.microsoft.com/en-us/windows/win32/api/webservices/nf-webservices-wsstartreadercanonicalization
The usage pattern for canonicalization is:
  1)  Move the Reader to the element where canonicalization begins.
  2)  Call WsStartReaderCanonicalization.
  3)  Move the Reader forward to the end position.
  4)  Call WsEndReaderCanonicalization.

*)
// Step1: Move the Reader to the element where canonicalization begins.  [this gives an error]
    if hr=NOERROR then
      hr := WsMoveReader(reader, WS_MOVE_TO_PARENT_ELEMENT, @Found, error);

// Step2 : Call WsStartReaderCanonicalization.
    MyCallbackStatus := 0;
    if hr=NOERROR then
      hr:=WsStartReaderCanonicalization(reader, MyCallback, @MyCallbackStatus, nil, 0, error);

// Step3: Move the Reader forward to the end position.  [this gives an error]
    if hr=NOERROR then
      hr := WsMoveReader(reader, WS_MOVE_TO_EOF, @Found, error);

// Step4 : Call WsEndReaderCanonicalization  [this will call MyCallback]
    if hr=NOERROR then
      hr := WsEndReaderCanonicalization(reader, error);
  end;

  //----------------------------------------
  //My test End
  //----------------------------------------

  if hr <> NOERROR then
  begin
    PrintError(hr,error);
    ExitCode:=-1;
  end;


  if writer<>nil then WsFreeWriter(writer);
  if reader<>nil then WsFreeReader(reader);
  if heap<>nil then WsFreeHeap(heap);
  if error<>nil then WsFreeError(error);

  Readln;
  halt(exitcode);
end.

核心问题原因 #

1. WsMoveReader调用错误
   调用WsMoveReader(reader, WS_MOVE_TO_PARENT_ELEMENT, ...)时，XML阅读器处于文档起始位置，没有父元素可跳转，直接触发无效操作错误。

2. 回调buffer为nil
   删除WsMoveReader后，阅读器仍停在文档起始位置，调用规范化函数后未遍历XML内容，导致没有任何规范化数据生成，回调的buffer自然为nil。

修正方案 #

1. 正确定位阅读器起始位置 #

将初始的WS_MOVE_TO_PARENT_ELEMENT替换为定位到根元素：

// 替换原Step1代码
if hr=NOERROR then
  hr := WsMoveReader(reader, WS_MOVE_TO_ROOT_ELEMENT, @Found, error);

若需规范化特定子元素，可在定位根元素后，继续用WsMoveReader配合WS_MOVE_TO_NEXT_ELEMENT等参数定位目标节点。

2. 正确遍历XML内容 #

调用WsStartReaderCanonicalization后，必须逐节点遍历XML，而非直接跳转到EOF（无法触发数据收集）：

// 替换原Step3代码
if hr=NOERROR then
begin
  // 循环移动阅读器直到遍历完所有节点
  repeat
    hr := WsMoveReader(reader, WS_MOVE_TO_NEXT_NODE, @Found, error);
    if hr <> NOERROR then Break;
  until not Found;
end;

3. 修正回调函数逻辑 #

确保回调函数返回成功状态，否则规范化流程会提前终止：

function MyCallback(callbackState : pointer; buffer : PWS_BYTES; count : ULONG;
                     asyncContext : PWS_ASYNC_CONTEXT; error : PWS_ERROR):HRESULT; stdcall;
var
  S : AnsiString;
begin
  Writeln('Inside MyCallback :');
  Writeln('MyCallbackStatus :', IntToStr(MyCallbackStatus));
  if Assigned(error) then PrintError(0, error);

  if Assigned(buffer) then
  begin
    SetString(S, PAnsiChar(buffer.bytes), buffer.length);
    Writeln(s);
  end
  else
    Writeln('Buffer is nil');

  Result := NOERROR; // 必须返回成功状态
end;

内容的提问来源于stack exchange，提问作者Ehab