我正在使用 Delphi7 修改旧项目以添加使用证书和签名。经过一些搜索后，我发现了XML规范化函数，但我无法让这些函数中的任何一个起作用：
这些函数包含在 Microsoft WebServices.dll 中，我在其中找到了它的标头翻译 Github但我仍然没有运气。这是我测试的代码：
{$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.
正如您在代码中看到的，函数 WsMoveReader() 给出了错误。当我删除对 WsMoveReader() 的调用时，代码完整且没有错误，但当调用 MyCallback 时，缓冲区参数为零。任何帮助将不胜感激。
经过多次尝试，我终于找到了问题的答案。该解决方案有些原始，但它执行了所需的功能。这是我的代码。
以下是一个虚拟函数，但如果没有它，代码将无法运行。我尝试使用
{$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.
nil规范函数。
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;
注：
在某些情况下，该函数在实际结果之前和之后返回“#10”，因此必须像这样修改结果：
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;
我知道答案来晚了，但由于我还没有找到使用 WWSAPI 规范化的工作示例，所以我在这里留下了执行不同类型规范化的函数的完整代码。
解决方案是使用功能
SetString(Result, PAnsiChar(newXml), newXmlLength);
Result := Trim(Result);
WsReadNode使用示例：
uses
Webservices, StrUtils, Math;
function MyCallback(callbackState: Pointer; buffer: PWS_BYTES; count: ULONG;
asyncContext: PWS_ASYNC_CONTEXT; error: PWS_ERROR): HRESULT; stdcall;
var
s: AnsiString;
begin
while count > 0 do // repeat for each item of buffer array
begin
if Assigned(buffer) then
SetString(s, PAnsiChar(buffer.bytes), buffer.length);
string(callbackState^) := string(callbackState^) + string(s);
Inc(buffer);
Dec(count);
end;
Result := 0;
end;
function CanonicalXML(XmlString: string;
Exclusive: Boolean;
WithComment: Boolean;
SubsetByTag: string;
PrefixList: array of string): string;
var
wsError: PWS_ERROR;
// translate string to WS_XML_STRING
function WS_XML_STRING_VALUE(s: string): WS_XML_STRING;
begin
Result.length := Length(s);
Result.bytes := PByte(UTF8String(s));
Result.dictionary := nil;
Result.id := 0;
end;
// Translate WS_XML_STRING to string
function GetXmlString(wsString: WS_XML_STRING): string;
begin
SetString(Result, PAnsiChar(wsString.bytes), wsString.length);
end;
function GetXmlElementName(wsElement: WS_XML_ELEMENT_NODE): string;
begin
Result := GetXmlString(wsElement.prefix^);
if Result <> '' then
Result := Result + ':';
Result := Result + GetXmlString(wsElement.localName^)
end;
// Raise a detailed error if needed
procedure CheckError(r: HRESULT);
var
s: string;
i,
errorCount: ULONG;
errorString: WS_STRING;
begin
if r = NOERROR then
Exit;
s := Format('Error code: 0x%x'#13, [r]);
if (r = E_INVALIDARG) or (r = WS_E_INVALID_OPERATION) then
raise Exception.Create(s + 'Invalid operation')
else if WsGetErrorProperty(wsError, WS_ERROR_PROPERTY_STRING_COUNT, @errorCount, sizeof(errorCount)) = NOERROR then
begin
for i := 0 to errorCount - 1 do
if WsGetErrorString(wsError, i, @errorString) = NOERROR then
s := s + WideCharLenToString(errorString.chars, errorString.length) + #13;
raise Exception.Create(s);
end;
end;
const
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
wsHeap: PWS_HEAP;
wsBuffer: PWS_XML_BUFFER;
wsReader: PWS_XML_READER;
wsNode: PWS_XML_NODE;
CanProp: array [0..1] of WS_XML_CANONICALIZATION_PROPERTY;
Algorithm: ULONG;
wsPrefixes: WS_XML_CANONICALIZATION_INCLUSIVE_PREFIXES;
wsPrefixesXmlStrings: array of WS_XML_STRING;
Xml: UTF8String;
Found: BOOL;
XmlCanon: string;
i: Integer;
begin
XmlCanon := '';
wsError := nil;
wsHeap := nil;
wsReader := nil;
wsBuffer := nil;
wsNode := nil;
Xml := UTF8String(XmlString);
try
CheckError(WsCreateError(nil, 0, @wsError));
CheckError(WsCreateReader(nil, 0, @wsReader, wsError));
CheckError(WsCreateHeap(128 * 1024, 512, nil, 0, @wsHeap, wsError));
// read from xml to buffer
CheckError(WsReadXmlBufferFromBytes(wsReader, nil, nil, 0, PAnsiChar(Xml), length(Xml), wsHeap, @wsBuffer, wsError));
// set reader to use buffer
CheckError(WsSetInputToBuffer(wsReader, wsBuffer, nil, 0, wsError));
// move to BOF
CheckError(WsMoveReader(wsReader, WS_MOVE_TO_BOF, @Found, wsError));
if Found then
begin
// if exclusive, you can canonicalize only a subset, move to it
if Exclusive then
if SubsetByTag <> '' then
begin
CheckError(WsGetReaderNode(wsReader, @wsNode, wsError));
while wsNode.nodeType <> WS_XML_NODE_TYPE_EOF do
begin
if wsNode.nodeType = WS_XML_NODE_TYPE_ELEMENT then
if SubsetByTag <> '' then
begin
if GetXmlElementName(PWS_XML_ELEMENT_NODE(wsNode)^) = SubsetByTag then
Break;
end;
// move to next node
CheckError(WsReadNode(wsReader, wsError));
CheckError(WsGetReaderNode(wsReader, @wsNode, wsError));
end;
end;
CheckError(WsGetReaderNode(wsReader, @wsNode, wsError));
// if reader position is ok starts canonicalization
if wsNode.nodeType <> WS_XML_NODE_TYPE_EOF then
begin
// param algorithm
Algorithm := Exclusives[Exclusive, WithComment];
CanProp[0].id := WS_XML_CANONICALIZATION_PROPERTY_ALGORITHM;
CanProp[0].value := @Algorithm;
CanProp[0].valueSize := SizeOf(Algorithm);
// Param included prefix list
if Length(PrefixList) > 0 then
begin
wsPrefixes.prefixCount := Length(PrefixList);
SetLength(wsPrefixesXmlStrings, wsPrefixes.prefixCount);
for i := 0 to wsPrefixes.prefixCount - 1 do
wsPrefixesXmlStrings[i] := WS_XML_STRING_VALUE(PrefixList[i]);
wsPrefixes.prefixes := @wsPrefixesXmlStrings[0];
CanProp[1].id := WS_XML_CANONICALIZATION_PROPERTY_INCLUSIVE_PREFIXES;
CanProp[1].value := @wsPrefixes;
CanProp[1].valueSize := SizeOf(wsPrefixes);
end;
// start
CheckError(WsStartReaderCanonicalization(wsReader, MyCallback, @XmlCanon, @CanProp[0], IfThen(Length(PrefixList) = 0, 1, 2), wsError));
// if starts at BOF move node by node until ends
if wsNode.nodeType = WS_XML_NODE_TYPE_BOF then
begin
while wsNode.nodeType <> WS_XML_NODE_TYPE_EOF do
begin
CheckError(WsReadNode(wsReader, wsError));
CheckError(WsGetReaderNode(wsReader, @wsNode, wsError));
end;
end
else // sub node, only move from this node to the next, skipping childs
CheckError(WsSkipNode(wsReader, wsError));
// ends
CheckError(WsEndReaderCanonicalization(wsReader, wsError));
end;
end;
// callback function wrote to XmlCanon variable
Result := XmlCanon;
finally
if Assigned(wsReader) then WsFreeReader(wsReader);
if Assigned(wsHeap) then WsFreeHeap(wsHeap);
if Assigned(wsError) then WsFreeError(wsError);
end;
end;