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, u

Answer 1

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 (cedomir.plavljanic@yahoo.com)
// 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:Anskya@Gmail.com
//  - 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;
//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:Anskya@Gmail.com
//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:Anskya@Gmail.com
//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;

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;
  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.Create;
    AddNameSpace;
finalization
  UnHookXMLNodeLibrary;
    ListNameSpace.DisposeOf;
end.