Accessing IXMLDOMDocument2 via TXMLDocument? - delphi

Question

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??

Answer 1

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.

Answer 2

Note that in XE3 and above, MSXMLDOMDocumentCreate is deprecated in favor of subclassing TMSXMLDOMDocumentFactory and overriding it's CreateDOMDocument function. For future reference, here's an example for XE3 and XE4:
interface
type
TMSXMLDOMDocument2Factory = class(TMSXMLDOMDocumentFactory)
public
class function CreateDOMDocument: IXMLDOMDocument; override;
end;
implementation
{ TMSXMLDOMDocument2Factory }
class function TMSXMLDOMDocument2Factory.CreateDOMDocument: IXMLDOMDocument;
begin
Result := inherited;
if not Assigned(Result) then
raise DOMException.Create(SMSDOMNotInstalled);
AddDOMProperty('AllowXsltScript', True);
SetDOMProperties(Result as IXMLDOMDocument2);
end;
initialization
MSXMLDOMDocumentFactory := TMSXMLDOMDocument2Factory;
end.