Search code examples
delphimsxmltxmldocument

Accessing IXMLDOMDocument2 via TXMLDocument?


I have some working code using Delphi's TXMLDocument class, and using the TransformNode method to perform XSLT translation.

But, I need to enable XSLT Javascript functions (<msxml:script> tags) and - after much googling - this means I need to set the AllowXsltScript property of the IXMLDOMDocument2 to true.

http://msdn.microsoft.com/en-us/library/windows/desktop/ms760290(v=vs.85).aspx

I've achieved this successfully - but only by modifying the source of the Delphi Library function CreateDOMDocument in msxmldom.pas.

function CreateDOMDocument: IXMLDOMDocument;
var doc :IXMLDOMDocument2;
begin

  doc := TryObjectCreate([CLASS_DOMDocument60, CLASS_DOMDocument40, CLASS_DOMDocument30,
    CLASS_DOMDocument26, msxml.CLASS_DOMDocument]) as IXMLDOMDocument2;
  if not Assigned(doc) then
    raise DOMException.Create(SMSDOMNotInstalled);
  doc.setProperty('AllowXsltScript', true);  // Allow XSLT scripts!!
  Result := doc;
end;

Obviously this is far from satisfactory - so how can I access IXMLDOMDocument2 objects without modifying library code??


Solution

  • You can override the create function via the MSXMLDOMDocumentCreate variable:

    unit Unit27;
    
    interface
    
    uses
      xmldoc, xmlintf, msxml, msxmldom, Forms, SysUtils, 
      ActiveX, ComObj, XmlDom, XmlConst,
      Windows, Messages, Classes, Controls, StdCtrls;
    
    type
      TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    function TryObjectCreate(const GuidList: array of TGuid): IUnknown;
    var
      I: Integer;
      Status: HResult;
    begin
      Status := S_OK;
      for I := Low(GuidList) to High(GuidList) do
      begin
        Status := CoCreateInstance(GuidList[I], nil, CLSCTX_INPROC_SERVER or
          CLSCTX_LOCAL_SERVER, IDispatch, Result);
        if Status = S_OK then Exit;
      end;
      OleCheck(Status);
    end;
    
    function CreateDOMDocument2: IXMLDOMDocument;
    
    var
      Doc2 : IXMLDOMDocument2;
    
    begin
      Doc2 := TryObjectCreate([CLASS_DOMDocument60, CLASS_DOMDocument40, CLASS_DOMDocument30,
        CLASS_DOMDocument26, msxml.CLASS_DOMDocument]) as IXMLDOMDocument2;
      if not Assigned(Doc2) then
        raise DOMException.Create(SMSDOMNotInstalled);
      Doc2.setProperty('AllowXsltScript', true);
      Result := Doc2;
    end;
    
    
    procedure TForm1.FormCreate(Sender: TObject);
    
    var
     Doc : IXMLDocument;
    
    begin
     Doc := TXMLDocument.Create(nil);
     Doc.LoadFromFile('c:\temp\test.xml');
    end;
    
    
    initialization
     MSXMLDOMDocumentCreate := CreateDOMDocument2;
    end.