How do I add a namespace prefix to each node using TXMLDocument

Question

I used the XML Binding Wizard to create a descendant of TXMLDocument. The files generated by this class would declare the namespace in the root node and create just plain, unadorned nodes for the rest of the document.

<?xml version="1.0"?>
<RootNode xmlns="URL" xmlns:xsi="URL" xsi:schemaLocation="URL">
    <SomeNode>
        <AnotherNode>Value</AnotherNode>
    </SomeNode>
</RootNode>

I've had no trouble reading or validating this at all. However, the processor where these files are sent now requires each node to have the namespace prefixed in order to process files correctly.

<?xml version="1.0"?>
<NS:RootNode xmlns:NS="URL" xmlns:xsi="URL" xsi:schemaLocation="URL">
    <NS:SomeNode>
        <NS:AnotherNode>Value</NS:AnotherNode>
    </NS:SomeNode>
</NS:RootNode>

How do I accomplish this with my TXMLDocument descendant? I hope it doesn't involve hand editing 10000 lines of generated code.

Answer 1

Ok, the solution took a long time to discover but was surprisingly simple.

The code generated by XML Data Binding Wizard will create xml using the default namespace. You can see this by examining the Get, Load and New functions in the generated unit. All three make calls to GetDocBinding, passing in TargetNamespace as the final parameter. TargetNamespace is a global constant string with the URI extracted from the schema or xml document you fed to the Binding Wizard.

Because TargetNamespace is assigned to the root element as the default namespace no child elements will have a prefix.

The way to do this:

FDocumentName := 
  NewXMLDocument.GetDocBinding(
    'ns:DocumentName', // <-- Just add the prefix to the root node.
    TXMLDocumentName,
    TargetNamespace) as IXMLDocumentName;

Now the root node will look like:

<ns:DocumentName xmlns:ns="URI">

And all child nodes will have the prefix when they are created.

Answer 2

Possible solution to the problem with multiple namespace: hooking and class helper

//
// The original Delphi code is : XMLHookUnit.pas released 2015.09.20
// Last version: 0.1 released 2015.09.20
// The initial developer is Cedomir Plavljanic ([email protected])
// Copyright (C) 2015-2015 Cedomir Plavljanic
//
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version
//
// This unit is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
//
// This unit hooking 2 methods from XMLDoc.TXMLNode and 1 method from XMLDoc.TXMLNodeList
// Allows use of units created with XML binding wizard with multiple namespace
//
// This is only test
//
//        XML Binding Wizard
//          - change all the names that end with _ (All signature nodes have this problem)
//          - example: TSignatureType_ -> TSignatureType_ds
//
// Usage: add the unit to project
//
// This unit contains variables
//    - ListNameSpace - dictionary for pair prefixes and namespace
//          - in example pair is from XML Schema Definition in UBL 2.1 by Oasis
//            http://docs.oasis-open.org/ubl/os-UBL-2.1/UBL-2.1.html
//          - for own use must changed
//    - DigitalSignatureWithoutPrefix - flag for add or remove digital signature prefix in nodename
//
//
// This unit contains Helper: TXMLNodeListHelper, TXMLNodeHelper
// This unit contains function for hooking TXMLNode and TXMLNodeList
// For hooking in testing using example from Hook Api Library 0.2 [Ring3] By Anskya Email:[email protected]
//  - with litle modification in call function VirtualProtect
//      - flNewProtect used as PAGE_READWRITE
//
// version: 0.1
// can be used with all versions of Delphi that have suport generic TDictionary
// for older versions of Delphi have to ask via e-mail or add support for TDictionary
// I also have a version for Delphi 2007 (XML binding wizard is bad, must be used from newer version of Delphi)
//


unit XMLHookUnit;

interface

uses
  System.Generics.Collections;

var
////Dictionary for pair prefixes and namespaces in all *.xsd file (without default namespace)
    ListNameSpace : TDictionary<String, String>;
//Include or Exclude ds: prefix in digital signature node
  DigitalSignatureWithoutPrefix : Boolean = True;

//Hook 1 methods from TXMLNodeList and 2 method from TXMLNode
//TXMLNodeList.GetNode
//TXMLNode.RegisterChildNode
//TXMLNode.InternalAddChildNode
//for hooking in testing using example from Hook Api Library 0.2 [Ring3] By Anskya Email:[email protected]
//with litle modification in call function VirtualProtect
//flNewProtect is PAGE_READWRITE
procedure HookXMLNodeLibrary;
//UnHook 1 methods from TXMLNodeList and 2 method from TXMLNode
//TXMLNodeList.GetNode
//TXMLNode.RegisterChildNode
//TXMLNode.InternalAddChildNode
//for unhooking in testing using example from Hook Api Library 0.2 [Ring3] By Anskya Email:[email protected]
//with litle modification in call function VirtualProtect
//flNewProtect is PAGE_READWRITE
procedure UnHookXMLNodeLibrary;

implementation

uses
  System.Types, StrUtils, Variants, HookApiLib, xmldom, XMLDoc, XMLIntf;

const
//namespace for digital signature
  NameSpace_DigitalSignature = 'http://www.w3.org/2000/09/xmldsig#';

var
//Flag is True if methods from XMLDoc are hooked
  IsHookXMLNodeLibrary : Boolean = False;

type
//access to proteted part in TXMLNodeList
  TXMLNodeListHelp = class(TXMLNodeList);
//access to proteted part in TXMLNode
  TXMLNodeHelp = class(TXMLNode);

//helper for TXMLNodelist
  TXMLNodeListHelper = class helper for TXMLNodeList
  public
//avoid overload trouble
//getnode call wrong findnode function
    function FindNodeHelp(aField: DOMString):IXMLNode;
//find prefix for node in ListNameSpace
    function FindPrefixHelp(aField:DOMString):String;
  end;

//helper function for TXMLNodelist
  TXMLNodeHelper = class helper for TXMLNode
  public
//extract LocalName, Prefix and Namespace based on NodeName
    procedure ExtractFieldPrefixNameSpace(const aNodeName: DOMString; out aField, aPrefix, aNameSpace: DOMString);
  end;

//prototype for hooking TXMLNodeList.GetNode
  TProtoTypeNodeListGetNode = function( const aSelf:TXMLNodeListHelp;
                                        const IndexOrName: OleVariant): IXMLNode;
//prototype for hooking TXMLNode.RegisterChildNode
  TProtoTypeNodeRegisterChildNode = procedure(const aSelf:TXMLNodeHelp;
                                              const aField: DOMString;
                                              const ChildNodeClass: TXMLNodeClass;
                                              const aNameSpace : DOMString);
//prototype for hooking TXMLNode.InternalAddChild
  TProtoTypeNodeInternalAddChild = function(const aSelf:TXMLNodeHelp;
                                            const NodeClass: TXMLNodeClass;
                                            const NodeName, NamespaceURI: DOMString;
                                            const Index: Integer): IXMLNode;

var
//Save old address for TXMLNodeList.GetNode
  SavePrototypeGetNode : TProtoTypeNodeListGetNode = nil;
//Save old address for TXMLNode.RegisterChildNode
  SaveProtoTypeRegisterChildNode : TProtoTypeNodeRegisterChildNode = nil;
//Save old address for TXMLNode.InternalAddChild
  SaveProtoTypeNodeInternalAddChild : TProtoTypeNodeInternalAddChild = nil;

{ TXMLNodeListHelper }

function TXMLNodeListHelper.FindNodeHelp(aField: DOMString): IXMLNode;

var
  aPrefix: string;

begin
  aPrefix := FindPrefixHelp(aField);
  if aPrefix <> '' then Result := FindNode(aPrefix+':'+aField, '');
  if Result = nil then Result := FindNode(aField, '');
end;

function TXMLNodeListHelper.FindPrefixHelp(aField: DOMString): String;

var
  aNodeClass:TNodeClassArray;
  i: Integer;
  aTest:TPair<String,String>;

begin
  Result := '';
  aNodeClass := TXMLNodeHelp(Self.Owner).ChildNodeClasses;
  aField:=ExtractLocalName(aField);
  for i := 0 to Length(aNodeClass)-1 do
    if aNodeClass[i].NodeName = aField then begin
      for aTest in ListNameSpace do begin
        if aTest.Value = aNodeClass[i].NamespaceURI then begin
          Result := aTest.Key;
          Break;
        end;
      end;
      Break;
    end;
end;

{ TXMLNodeHelper }
procedure TXMLNodeHelper.ExtractFieldPrefixNameSpace(const aNodeName : DOMString; out aField, aPrefix, aNameSpace: DOMString);
var
  i: Integer;
  sHelp:DOMString;
  Test:TPair<String,String>;
  Flag : Boolean;

begin
  sHelp := ExtractLocalName(aNodeName);
  aPrefix := '';
  aNameSpace := '';
  Flag := False;
  for i := 0 to Length(ChildNodeClasses) - 1 do begin
    if ChildNodeClasses[i].NodeName = sHelp then begin
      aNameSpace := ChildNodeClasses[i].NamespaceURI;
      for Test in ListNameSpace do begin
        if Test.Value = aNameSpace then begin
          aPrefix := Test.Key;
          Flag := DigitalSignatureWithoutPrefix and (aNameSpace = NameSpace_DigitalSignature);
          Break;
        end;
      end;
      Break;
    end;
  end;
  if (aPrefix = '') or (Flag) then begin
    aField := ExtractLocalName(aNodeName);
    if aNameSpace = '' then aNameSpace := GetNamespaceURI;
  end else
    aField := aPrefix + ':' + ExtractLocalName(aNodeName);
end;


//help function for find namaspase bassed on classname
//last part after underscore in classname is prefix
function GetNameSpace(const ChildNodeClass: TXMLNodeClass): DOMString;

var
  aList : TStringDynArray;

begin
  Result := ChildNodeClass.ClassName;
  aList:=StrUtils.SplitString(Result,'_');
  if Length(aList)>1 then
    ListNameSpace.TryGetValue(aList[Length(aList)-1],Result)
  else
   Result := '';
end;

//replace for TXMLNodeList.GetNode
function GetNodeHelp( const aSelf:TXMLNodeListHelp;
                      const IndexOrName: OleVariant):IXMLNode;

begin
  if VarIsOrdinal(IndexOrName) then
    Result := SavePrototypeGetNode(aSelf,IndexOrName)
  else begin
    Result := aSelf.FindNodeHelp(DOMString(IndexOrName));
    if Result = nil then
      Result := SavePrototypeGetNode(aSelf,IndexOrName);
  end;
end;

//replace for TXMLNode.RegisterChildNode
procedure RegisterChildNodeHelp(const aSelf:TXMLNodeHelp;
                                const aField: DOMString;
                                const ChildNodeClass: TXMLNodeClass;
                                const aNameSpace : DOMString);

var
  hNameSpace: DOMString;

begin
  if aNameSpace<>'' then
    hNameSpace := aNameSpace
  else begin
    hNameSpace := GetNameSpace(ChildNodeClass);
    if hNameSpace = '' then hNameSpace := aSelf.GetNamespaceURI;
  end;
  SaveProtoTypeRegisterChildNode(aSelf, aField, ChildNodeClass, hNameSpace);
end;

//replace for TXMLNode.InternalAddChild
function InternalAddChildHelp(const aSelf:TXMLNodeHelp;
                              const NodeClass: TXMLNodeClass;
                              const NodeName, NamespaceURI: DOMString;
                              const Index: Integer): IXMLNode;

var
  aField, aPrefix, aNameSpace:DOMString;

begin
  aSelf.ExtractFieldPrefixNameSpace(NodeName, aField, aPrefix, aNameSpace);
  Result := SaveProtoTypeNodeInternalAddChild(aSelf, NodeClass, aField, aNameSpace, Index);
end;


procedure HookXMLNodeLibrary;

begin
  if IsHookXMLNodeLibrary then Exit;

  @SavePrototypeGetNode := HookCode(@TXMLNodeListHelp.GetNode, @GetNodeHelp);
  @SaveProtoTypeRegisterChildNode := HookCode(@TXMLNodeHelp.RegisterChildNode, @RegisterChildNodeHelp);
  @SaveProtoTypeNodeInternalAddChild := HookCode(@TXMLNodeHelp.InternalAddChild, @InternalAddChildHelp);
  IsHookXMLNodeLibrary := True;
end;

procedure UnHookXMLNodeLibrary;

begin
  if not IsHookXMLNodeLibrary then Exit;

  UnHookCode(@SavePrototypeGetNode);
  UnHookCode(@SaveProtoTypeRegisterChildNode);

  UnHookCode(@SaveProtoTypeNodeInternalAddChild);

  SavePrototypeGetNode := nil;
  SaveProtoTypeRegisterChildNode := nil;
  SaveProtoTypeNodeInternalAddChild := nil;

  IsHookXMLNodeLibrary := False;
end;

//Dictionary for prefixes and namespaces
procedure AddNameSpace;

begin
    ListNameSpace.Add('xsd','http://www.w3.org/2001/XMLSchema');
    ListNameSpace.Add('cac','urn:oasis:names:specification:ubl:schema:xsd:CommonAggregateComponents-2');
    ListNameSpace.Add('cbc','urn:oasis:names:specification:ubl:schema:xsd:CommonBasicComponents-2');
    ListNameSpace.Add('ccts','urn:un:unece:uncefact:documentation:2');
    ListNameSpace.Add('ext','urn:oasis:names:specification:ubl:schema:xsd:CommonExtensionComponents-2');
    ListNameSpace.Add('udt','urn:oasis:names:specification:ubl:schema:xsd:UnqualifiedDataTypes-2');
    ListNameSpace.Add('qdt','urn:oasis:names:specification:ubl:schema:xsd:QualifiedDataTypes-2');
    ListNameSpace.Add('ccts-cct','urn:un:unece:uncefact:data:specification:CoreComponentTypeSchemaModule:2');
    ListNameSpace.Add('cct','urn:un:unece:uncefact:data:specification:CoreComponentTypeSchemaModule:2');
    ListNameSpace.Add('sig','urn:oasis:names:specification:ubl:schema:xsd:CommonSignatureComponents-2');
    ListNameSpace.Add('sac','urn:oasis:names:specification:ubl:schema:xsd:SignatureAggregateComponents-2');
    ListNameSpace.Add('ds','http://www.w3.org/2000/09/xmldsig#');
    ListNameSpace.Add('sbc','urn:oasis:names:specification:ubl:schema:xsd:SignatureBasicComponents-2');
  ListNameSpace.Add('xsi','http://www.w3.org/2001/XMLSchema-instance');

end;

initialization
  HookXMLNodeLibrary;
    ListNameSpace := TDictionary<String,String>.Create;
    AddNameSpace;
finalization
  UnHookXMLNodeLibrary;
    ListNameSpace.DisposeOf;
end.