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

Inspired by the solution of Cedomir Plavljanic, I created unit hooking delphi methods and allows easy use units created with Delphi XML Binding Wizard with multiple namespace and proper prefixes.

XMLDocHelper

unit XMLDocHelper;

(*
  (CreateCollection\(.+?,.+?, ')(.+?)\)
  \1tns:\2\)
  RegisterChildNode('
  RegisterChildNode('tns:
  ChildNodes['
  ChildNodes['tns:
  ItemTag := '
  ItemTag := 'tns:
*)

interface

uses DDetours, System.Variants, System.Generics.Collections, System.SysUtils, Xml.XMLDoc, Xml.XMLIntf, Xml.xmldom;

type
  TXMLNodeHelp = class(TXMLNode);
  TXMLNodeListHelp = class(TXMLNodeList);
  TXMLNodeCollectionHelp = class(TXMLNodeCollection);

type
  TXMLNodeHelper = class helper for TXMLNode
  public
    function _FindNamespaceURI(const TagOrPrefix: DOMString): DOMString;
  end;

var
  TrampolineXMLNode_RegisterChildNode: procedure(const aSelf: TXMLNodeHelp; const TagName: DOMString; ChildNodeClass: TXMLNodeClass; NamespaceURI: DOMString = '') = nil;
  TrampolineXMLNode_CreateCollection: function(const aSelf: TXMLNodeHelp; const CollectionClass: TXMLNodeCollectionClass; const ItemInterface: TGuid; const ItemTag: DOMString; ItemNS: DOMString = ''): TXMLNodeCollection = nil;
  TrampolineXMLNode_InternalAddChild: function(const aSelf: TXMLNodeHelp; NodeClass: TXMLNodeClass; const NodeName, NamespaceURI: DOMString; Index: Integer): IXMLNode;
  TrampolineXMLNodeList_GetNode: function(const aSelf: TXMLNodeListHelp; const aIndexOrName: OleVariant): IXMLNode = nil;
  TrampolineXMLNodeCollection_IsCollectionItem: function(const aSelf: TXMLNodeCollectionHelp; const Node: IXMLNode): Boolean;

implementation

procedure XMLNode_RegisterChildNodeHooked(const aSelf: TXMLNodeHelp; const TagName: DOMString; ChildNodeClass: TXMLNodeClass; NamespaceURI: DOMString = '');
begin
  if IsPrefixed(TagName) and (NamespaceURI = '') then
    TrampolineXMLNode_RegisterChildNode(aSelf, TagName, ChildNodeClass, aSelf._FindNamespaceURI(TagName))
  else
    TrampolineXMLNode_RegisterChildNode(aSelf, TagName, ChildNodeClass, NamespaceURI);
end;

function XMLNode_CreateCollectionHooked(const aSelf: TXMLNodeHelp; const CollectionClass: TXMLNodeCollectionClass; const ItemInterface: TGuid; const ItemTag: DOMString; ItemNS: DOMString = ''): TXMLNodeCollection;
begin
  Result := nil;
  if IsPrefixed(ItemTag) and (ItemNS = '') then
    Result := TrampolineXMLNode_CreateCollection(aSelf, CollectionClass, ItemInterface, ItemTag, aSelf._FindNamespaceURI(ItemTag));
  if Result = nil then
    Result := TrampolineXMLNode_CreateCollection(aSelf, CollectionClass, ItemInterface, ItemTag, ItemNS);
end;

function XMLNode_InternalAddChildHooked(const aSelf: TXMLNodeHelp; NodeClass: TXMLNodeClass; const NodeName, NamespaceURI: DOMString; Index: Integer): IXMLNode;
var
  NS: string;
begin
  NS := aSelf._FindNamespaceURI(NodeName);
  if NS = '' then
    NS := NamespaceURI;
  Result := TrampolineXMLNode_InternalAddChild(aSelf, NodeClass, NodeName, NS, Index)
end;

function XMLNodeList_GetNodeHooked(const aSelf: TXMLNodeListHelp; const aIndexOrName: OleVariant): IXMLNode;
begin
  if VarIsOrdinal(aIndexOrName) then
    Result := TrampolineXMLNodeList_GetNode(aSelf, aIndexOrName)
  else
  begin
    if IsPrefixed(aIndexOrName) then
      Result := aSelf.FindNode(ExtractLocalName(aIndexOrName), aSelf.Owner._FindNamespaceURI(aIndexOrName));
    if Result = nil then
      Result := TrampolineXMLNodeList_GetNode(aSelf, aIndexOrName);
  end;
end;

function XMLNodeCollection_IsCollectionItem(const aSelf: TXMLNodeCollectionHelp; const Node: IXMLNode): Boolean;

const
  AdjustIndex = 1 - Low(string);

type
  TStringSplitOption = (ssNone, ssRemoveEmptyEntries);
  TStringSplitOptions = set of TStringSplitOption;
  TDOMStringDynArray = array of DOMString;

  function SplitString(const S: DOMString; Delimiter: WideChar; const StringSplitOptions: TStringSplitOptions = []): TDOMStringDynArray;
  var
    LInputLength, LResultCapacity, LResultCount, LCurPos, LSplitStartPos: Integer;
  begin
    { Get the current capacity of the result array }
    LResultCapacity := Length(Result);
    { Reset the number of results already set }
    LResultCount := 0;
    { Start at the first character }
    LSplitStartPos := 1;
    { Save the length of the input }
    LInputLength := Length(S);
    { Step through the entire string }
    for LCurPos := 1 to LInputLength do
    begin
      { Find a delimiter }
      if S[LCurPos - AdjustIndex] = Delimiter then
      begin
        { Is the split non-empty, or are empty strings allowed? }
        if (LSplitStartPos < LCurPos) or not(ssRemoveEmptyEntries in StringSplitOptions) then
        begin
          { Split must be added - is there enough capacity in the result array? }
          if LResultCount = LResultCapacity then
          begin
            { Grow the result array - make it slightly more than double the
              current size }
            LResultCapacity := LResultCapacity * 2 + 8;
            SetLength(Result, LResultCapacity);
          end;
          { Set the string }
          SetString(Result[LResultCount], PWideChar(@S[LSplitStartPos - AdjustIndex]), LCurPos - LSplitStartPos);
          { Increment the result count }
          Inc(LResultCount);
        end;
        { Set the next split start position }
        LSplitStartPos := LCurPos + 1;
      end;
    end;
    { Add the final split }
    if (LSplitStartPos <= LInputLength) or not(ssRemoveEmptyEntries in StringSplitOptions) then
    begin
      { Correct the output length }
      if LResultCount + 1 <> LResultCapacity then
        SetLength(Result, LResultCount + 1);
      { Set the string }
      SetString(Result[LResultCount], PWideChar(@S[LSplitStartPos - AdjustIndex]), LInputLength - LSplitStartPos + 1);
    end
    else
    begin
      { No final split - correct the output length }
      if LResultCount <> LResultCapacity then
        SetLength(Result, LResultCount);
    end;
  end;

var
  I: Integer;
  LocalName: DOMString;
  FItemTags: TDOMStringDynArray;
begin
  Result := False;
  if Supports(Node, aSelf.ItemInterface) then
  begin
    LocalName := ExtractLocalName(Node.NodeName);
    Result := (LocalName = ExtractLocalName(aSelf.ItemTag)); // here is the Bug
    // If FItemTag has semicolons in it, then there are multiple valid names and we must check each one
    if not Result and (Pos(';', aSelf.ItemTag) > 0) then
    begin
      FItemTags := SplitString(aSelf.ItemTag, ';', [ssRemoveEmptyEntries]);
      for I := Low(FItemTags) to High(FItemTags) do
        if LocalName = ExtractLocalName(FItemTags[I]) then // and here is the Bug
        begin
          Result := True;
          Break;
        end;
    end;
  end;
end;

function TXMLNodeHelper._FindNamespaceURI(const TagOrPrefix: DOMString): DOMString;
begin
  Result := FindNamespaceURI(TagOrPrefix);
end;

initialization

@TrampolineXMLNode_RegisterChildNode := InterceptCreate(@TXMLNodeHelp.RegisterChildNode, @XMLNode_RegisterChildNodeHooked);
@TrampolineXMLNode_CreateCollection := InterceptCreate(@TXMLNodeHelp.CreateCollection, @XMLNode_CreateCollectionHooked);
@TrampolineXMLNode_InternalAddChild := InterceptCreate(@TXMLNodeHelp.InternalAddChild, @XMLNode_InternalAddChildHooked);
@TrampolineXMLNodeList_GetNode := InterceptCreate(@TXMLNodeListHelp.GetNode, @XMLNodeList_GetNodeHooked);
@TrampolineXMLNodeCollection_IsCollectionItem := InterceptCreate(@TXMLNodeCollectionHelp.IsCollectionItem, @XMLNodeCollection_IsCollectionItem);

finalization

if Assigned(TrampolineXMLNode_RegisterChildNode) then
begin
  InterceptRemove(@TrampolineXMLNode_RegisterChildNode);
  TrampolineXMLNode_RegisterChildNode := nil;
end;

if Assigned(TrampolineXMLNode_CreateCollection) then
begin
  InterceptRemove(@TrampolineXMLNode_CreateCollection);
  TrampolineXMLNode_CreateCollection := nil;
end;

if Assigned(TrampolineXMLNode_InternalAddChild) then
begin
  InterceptRemove(@TrampolineXMLNode_InternalAddChild);
  TrampolineXMLNode_InternalAddChild := nil;
end;

if Assigned(TrampolineXMLNodeList_GetNode) then
begin
  InterceptRemove(@TrampolineXMLNodeList_GetNode);
  TrampolineXMLNodeList_GetNode := nil;
end;

if Assigned(TrampolineXMLNodeCollection_IsCollectionItem) then
begin
  InterceptRemove(@TrampolineXMLNodeCollection_IsCollectionItem);
  TrampolineXMLNodeCollection_IsCollectionItem := nil;
end;

end.