Quick tip: using MSXML v6 with TXMLDocument in D7-D2007

By default, the VCL’s TXMLDocument class will delegate to MSXML for its actual parsing and writing. Now MSXML itself comes in various versions, with newer ones being installed side-by-side with older ones. To cope with this situation, the VCL tests for the existence of a number of them, the idea being to prefer whatever MSXML version was current when the unit in question (MSXMLDOM.pas) was last updated.

This has the consequence, though, of ignoring the most recent version of MSXML (which is v6) if you compile in D2007 or lower, since when these versions of Delphi were released, MSXML 6 was either not yet in existence, or only just so.

Stumbling across this recently, I found it to be an issue that’s easy enough to fix though – basically, you need to do something like the following:

unit CCR.UseMSXML6;

interface

implementation

{$IF CompilerVersion < 20.0}
uses ActiveX, MSXML, MSXMLDOM;

function CreateDOMDocumentEx: IXMLDOMDocument;
const
  CLASS_DOMDocument60: TGUID = '{88D96A05-F192-11D4-A65F-0040963251E5}';
begin
  Result := nil;
  if CoCreateInstance(CLASS_DOMDocument60, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IXMLDOMDocument, Result) <> S_OK then
  Result := CreateDOMDocument; //call the default implementation
end;

initialization
  MSXMLDOMDocumentCreate := CreateDOMDocumentEx;
{$IFEND}

end.

(I’ve wrapped things in the IF block given D2009’s MSXMLDOM.pas — I believe — added a check for MSXML 6.)

Alternatively, you might want to use an older MSXML version for some reason. In such a case, you could use a unit like the following (it requires D2006 or later given the nature of the implementation):

unit CCR.MSXML;

interface

uses
  ActiveX, MSXML, MSXMLDOM, XMLDOM, XMLConst;

type
  TMSXMLVersion = (mxCustom, mx26, mx30, mx40, mx60);

  MSXMLVersions = record
  strict private class var
    FActualCoClass, FPreferredCoClass: TGUID;
    FInitialized: Boolean;
    class function GetActual: TMSXMLVersion; static;
    class function GetPreferred: TMSXMLVersion; static;
    class procedure SetPreferred(const Value: TMSXMLVersion); static;
    class procedure SetPreferredCoClass(const GUID: TGUID); static;
    class function TryCreateObj(const GUIDList: array of TGUID;
      out Obj: IXMLDOMDocument): Boolean; static;
  public const
    CoClasses: array[TMSXMLVersion] of TGUID = (
      '{00000000-0000-0000-0000-000000000000}',
      '{F5078F1B-C551-11D3-89B9-0000F81FE221}',
      '{F5078F32-C551-11D3-89B9-0000F81FE221}',
      '{88D969C0-F192-11D4-A65F-0040963251E5}',
      '{88D96A05-F192-11D4-A65F-0040963251E5}');
    class function GetVersion(const GUID: TGUID): TMSXMLVersion; static;
    class function CreateDocument(Version: TMSXMLVersion): IXMLDOMDocument; overload; static;
    class function CreateDocument(const CoClass: TGUID): IXMLDOMDocument; overload; static;
    class function CreateDocument: IXMLDOMDocument; overload; static;
    class property Actual: TMSXMLVersion read GetActual;
    class property ActualCoClass: TGUID read FActualCoClass;
    class property Preferred: TMSXMLVersion read GetPreferred write SetPreferred;
    class property PreferredCoClass: TGUID read FPreferredCoClass write SetPreferredCoClass;
  end;

implementation

function CreateDOMDocumentViaMSXMLVersions: IXMLDOMDocument;
begin
  Result := MSXMLVersions.CreateDocument;
end;

class function MSXMLVersions.TryCreateObj(const GUIDList: array of TGUID;
  out Obj: IXMLDOMDocument): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := Low(GUIDList) to High(GUIDList) do
  begin
    FActualCoClass := GUIDList[I];
    if (CoCreateInstance(FActualCoClass, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER,
      IXMLDOMDocument, Obj) = S_OK) then Exit;
  end;
  FActualCoClass := GUID_NULL;
  Result := False;
end;

class function MSXMLVersions.CreateDocument(const CoClass: TGUID): IXMLDOMDocument;
begin
  if not TryCreateObj([CoClass], Result) then raise DOMException.Create(SMSDOMNotInstalled);
  if not FInitialized then
  begin
    FInitialized := True;
    FPreferredCoClass := CoClass;
  end;
end;

class function MSXMLVersions.CreateDocument(Version: TMSXMLVersion): IXMLDOMDocument;
begin
  if Version = mxCustom then
    Result := CreateDocument(PreferredCoClass)
  else
    Result := CreateDocument(CoClasses[Version]);
end;

class function MSXMLVersions.CreateDocument: IXMLDOMDocument;
begin
  if FInitialized and TryCreateObj([FPreferredCoClass], Result) then Exit;
  if not TryCreateObj([CoClasses[mx60], CoClasses[mx40], CoClasses[mx30],
    CoClasses[mx26]], Result) then raise DOMException.Create(SMSDOMNotInstalled);
  if not FInitialized then
  begin
    FInitialized := True;
    FPreferredCoClass := ActualCoClass;
  end;
end;

class function MSXMLVersions.GetActual: TMSXMLVersion;
begin
  Result := GetVersion(FACtualCoClass);
end;

class function MSXMLVersions.GetPreferred: TMSXMLVersion;
begin
  Result := GetVersion(FPreferredCoClass);
end;

class function MSXMLVersions.GetVersion(const GUID: TGUID): TMSXMLVersion;
begin
  for Result := High(TMSXMLVersion) downto Low(TMSXMLVersion) do
    if IsEqualGUID(GUID, CoClasses[Result]) then Exit;
  Result := mxCustom;
end;

class procedure MSXMLVersions.SetPreferred(const Value: TMSXMLVersion);
begin
  SetPreferredCoClass(CoClasses[Value]);
  if Value = mxCustom then FInitialized := False;
end;

class procedure MSXMLVersions.SetPreferredCoClass(const GUID: TGUID);
begin
  FPreferredCoClass := GUID;
  MSXMLDOMDocumentCreate := CreateDOMDocumentViaMSXMLVersions;
end;

end.

It can then be used like this –

uses CCR.MSXML;

function CreateXMLDocPreferingMSXML4: IXMLDocument;
begin
  MSXMLVersions.Preferred := mx40;
  Result := TXMLDocument.Create(nil);
end;

function CreateMSXML4Document: IXMLDOMDocument;
begin //it’s much faster to use the MS interface directly
  Result := MSXMLVersions.CreateDocument(mx40);
end;
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s