xmlweb-servicesdelphi

Error : Using Microsoft WebService.dll to canonicalize XML with Delphi7


I'm modifying an old project with Delphi7 to add using certificate and signing. After doing some search I found XML Canonicalization Functions but I couldn't get any of theses functions worked :

these functions are included in Microsoft WebServices.dll which I found a headers translation for it on Github but I still no luck. Here is the code I tested :

{$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.

As you can see in code, the function WsMoveReader() gives an error. When I delete the call to WsMoveReader() the code complete with no errors but when MyCallback is called, the buffer parameter is nil. Any help will be appreciated.


Solution

  • After many attempts, I finally found the answer to my question. This solution is somewhat primitive, but it performs the required function. Here is my code.

    The following is a dummy function but the code don't run without it. I tried to use nil instead of it but failed.

    uses
      Windows, Sysutils, Classes, webservices, wcrypt2, ncrypt;
    
    //   A user-defined callback used by the WS_XML_WRITER to write a buffer to some destination.
    function MyCallback(callbackState : pointer; buffer : PWS_BYTES; count : ULONG;
                         asyncContext : PWS_ASYNC_CONTEXT; error : PWS_ERROR):HRESULT; stdcall;
    begin
      Result := 0;
    end; 
    

    The canonical function.

    function CanonicalXML(xml : string; Exclusive:Boolean=True; WithComment:Boolean=True) : string;
    const
      HeapSize = 128 * 1024;  //128 KB for test
      Exclusives : array[Boolean, Boolean] of Integer = (
        (WS_INCLUSIVE_XML_CANONICALIZATION_ALGORITHM, WS_INCLUSIVE_WITH_COMMENTS_XML_CANONICALIZATION_ALGORITHM),
        (WS_EXCLUSIVE_XML_CANONICALIZATION_ALGORITHM, WS_EXCLUSIVE_WITH_COMMENTS_XML_CANONICALIZATION_ALGORITHM)
      );
      
    var
      hr:HRESULT;
      heap:PWS_HEAP;
      buffer:PWS_XML_BUFFER;
      writer:PWS_XML_WRITER;
      reader:PWS_XML_READER;
      newXml:pointer;
      newXmlLength :ULONG;
      MyCallbackStatus : Cardinal;
      CanProp : WS_XML_CANONICALIZATION_PROPERTY;
      PtrCanProp : PWS_XML_CANONICALIZATION_PROPERTY;
      Algorithm : ULONG;
    begin
      buffer := nil;
      writer := nil;
      reader := nil;
      
      //Setup algorithm used in canonicalization. 
      Algorithm := Exclusives[Exclusive, WithComment];
      CanProp.id := WS_XML_CANONICALIZATION_PROPERTY_ALGORITHM ;
      CanProp.value := @Algorithm;
      CanProp.valueSize := SizeOf(Algorithm);
      PtrCanProp := @CanProp;   
       
      hr := WsCreateReader(nil, 0, @reader, nil);     // Create an XML reader
    
      if hr=NOERROR then
        hr := WsCreateWriter(nil, 0, @writer, nil);   // Create an XML writer
    
      if (hr=NOERROR) then
        hr := WsCreateHeap(HeapSize, 512, nil, 0, @heap, nil); // Create a heap to store data
    
      if hr=NOERROR then    //read data into buffer
        hr:=WsReadXmlBufferFromBytes(reader, nil, nil, 0, PAnsiChar(xml), length(xml), heap, @buffer, nil);
    
      if hr=NOERROR then
        hr:=WsWriteXmlBufferToBytes(writer, buffer, nil, nil, 0, heap, @newXml, @newXmlLength, nil);
    
      if hr=NOERROR then
        hr := WsStartWriterCanonicalization(writer, MyCallback, @MyCallbackStatus, PtrCanProp, 1, nil);
      if hr=NOERROR then
        hr := WsEndWriterCanonicalization(writer, nil);
    
      if hr=NOERROR then
        SetString(Result, PAnsiChar(newXml), newXmlLength);
    
      //Free created objects
      if Assigned(writer) then WsFreeWriter(writer);
      if Assigned(reader) then WsFreeReader(reader);
      if Assigned(heap) then WsFreeHeap(heap);
    end;
    

    Note:
    In some cases this function returns "#10" before and after the actual result, so the result must be modified like :

    SetString(Result, PAnsiChar(newXml), newXmlLength);
    Result := Trim(Result);