Ayuda para mejorar la clase TghXMLDoc

[[Al González]]

En el sistema operativo Windows existe una API conocida como MSXML, la cual ofrece un rico conjunto de interfaces COM con las cuales podemos leer, escribir y manejar archivos XML evitándonos complicaciones de análisis sintáctico. Aprovechando esta circunstancia, hace más de un año comencé el desarrollo de una modesta clase de nombre TghXMLDoc (el infijo "gh" por ser parte de GH Freebrary), cuyo propósito es facilitar el uso de MSXML desde Delphi. Cabe mencionar que de esta clase derivé algunas otras, más específicas, relacionadas con el manejo de hojas de cálculo Excel (pues internamente también son archivos .xml). Y pretendo que esta clase sea la base para cualquier otra relacionada con documentos XML (para LibreOffice, por ejemplo) que haya que crear en el futuro dentro de la biblioteca.

La finalidad del tema que ahora abro es captar propuestas de mejoras o ampliaciones de esta clase base, y que entre los interesados ayudemos en el análisis y desarrollo de tales modificaciones. No está de más recordar que para formarnos una opinión sólida de lo ya hecho, primero conviene descargarla (disponible para Delphi 7 y pronto para XE2) y al menos haber examinado un poco su código fuente.

Expongo la primera inquietud de mejora. El actual constructor de la clase está así:

Código Delphi [-]
  Constructor TghXMLDoc.Create (Const AContent :String = '');
  Begin
    Content := CreateOLEObject ('MSXML2.DOMDocument.4.0');
    Content.Async := False;

    If (AContent <> '') And Not Load (AContent) Then
      ghRaise ('Invalid content or file for XML document.');
  End;

Podría extenderme explicando cada línea y quizá lo haga luego, pero ahora me gustaría hacer notar sólo lo que realiza la primera sentencia. Content es un campo o miembro de la clase y su tipo es OLEVariant. Como puede verse, en ese campo guardamos la interfaz de un objeto COM creado mediante la función nativa CreateOLEObject. Tendrán presente que a esta función debemos darle el nombre o ProgID que identifique la clase de objeto COM que deseamos crear. El ProgID MSXML2.DOMDocument.4.0 corresponde al objeto principal de MSXML, el que representa a un documento XML entero. Así es como la clase Delphi TghXMLDoc viene a encapsular un único documento XML a través de la interfaz asignada a Content.

En la parte final del ProgID aparece "4.0", y eso es lo que me interesa abordar con ustedes. Significa que, invariablemente, la actual implementación de TghXMLDoc requiere que la versión 4.0 de MSXML se encuentre presente en el sistema operativo, con sus debidos asientos en el Registro de Windows. Confieso que esa parte del código nunca me convenció del todo. ¿Por qué elegí específicamente la versión 4.0 de MSXML? La verdad no lo recuerdo, creo que bebí algunas cervezas ese día.

Según la hoja de ruta de la API, resulta que la versión 4.0 no viene "de cajón" en Windows, sino que se instala con algunos otros productos. Y aunque es rara la vez que no está presente y muy fácil instalarla con esta actualización, creo que TghXMLDoc debería poder aprovechar alguna otra de las versiones disponibles en el equipo, sin que el programador o el usuario tenga que actualizar nada. Lo que propongo es que la clase no esté "casada" con esa versión en concreto, sino que sea flexible y pueda utilizar alguna otra versión de MSXML vigente.

La pregunta del millón es ¿cuál es la mejor estrategia? Lo primero que se me ocurrió fue que podría agregarle algún parámetro (en el constructor) o propiedad para indicar la versión de MSXML con la cual debe trabajar. Pero luego pensé que el constructor de la clase podría examinar el Registro de Windows para determinar qué versiones hay instaladas y elegir el ProgID más apropiado ("MSXML2.DOMDocument.6.0", "MSXML2.DOMDocument.4.0",...). OK, ¿y si el programador quiere que se use uno en particular? (suponiendo que haya razones válidas para ello). Por otra parte, ¿es eficiente que el constructor busque en el Registro cada vez que creemos una instancia de TghXMLDoc? ¿no sería mejor hacer una única búsqueda y guardar el resultado en una variable global/de clase? Y haciéndolo así, ¿no importaría que la aplicación ignorase la instalación de alguna versión de MSXML ocurrida después de haber creado ya el primer objeto TghXMLDoc y antes de crear otros más? ¿Qué problemas de incompatibilidad tendría la clase si le permitimos trabajar con diferentes versiones de MSXML? ¿qué previsiones tendríamos que tomar?

Sí leemos la tabla MSXML Releases de la hoja de ruta que mencioné antes, podríamos decir que actualmente sólo hay tres versiones estándares y vigentes que valdría la pena considerar: la 3.0, la 4.0 y la 6.0. Y quizá la preferencia debería ser de mayor a menor, pero Microsoft dice (cito parte de esa tabla): When MSXML 6.0 is not available MSXML 3.0 is generally the best fallback version. [Cuando MSXML 6.0 no está disponible, MSXML 3.0 es generalmente la versión anterior más adecuada].

Bueno, creo que habrán entendido el tipo de interrogantes que se presentan para mejorar esa parte tan importante de la clase. Les solicito algo de ayuda para flexibilizarla y que use la versión de MSXML que se tenga instalada (o la que el programador indique), y no forzosamente la 4.0. Ideas, código, seudocódigo, pros y contras...toda colaboración será bienvenida. De antemano, gracias.

Al González.

[ecfisa]

Hola Alberto.

No puedo darte una opinión sobre que cuál ProgID es el más apropiado para que aplique tu clase por desconozco los alcances que deseas darle y las prestaciones que te ofrece cada versión para las mismas.

Pero, por si te sirviera de algo, te puedo dar una alternativa para obtener las versiones instaladas sin tener que recurrir al registro para obtenerlas. Hice dos funciones, la primera devuelve las versiones instaladas y la segunda la versión mayor de ellas.

Código Delphi [-]
uses ComObj, ActiveX;

procedure GetInstalledMSXML2Versions(Versions: TStrings);
const
  VERSION : array[1..8] of string = ('1.0','2.0','2.5','2.6','3.0','4.0','5.0','6.0');
var
 clsid: TCLSID;
 wc   : array[0..23] of WideChar;
 i    : Integer;
 s    : string;
begin
  for i := 1 to High(VERSION) do
  begin
    s := 'MSXML2.DOMDocument.' + VERSION[i];
    StringToWideChar(s , wc, High(wc));
    if Succeeded(CLSIDFromProgID(wc, clsid)) then
      Versions.Add(s);
  end;
end;

function GetMajorMSXML2VersionInstalled: string;
const
  VERSION : array[1..8] of string = ('1.0','2.0','2.5','2.6','3.0','4.0','5.0','6.0');
var
 clsid: TCLSID;
 wc   : array[0..23] of WideChar;
 i    : Integer;
 s    : string;
begin
  for i := 1 to High(VERSION) do
  begin
    s := 'MSXML2.DOMDocument.' + VERSION[i];
    StringToWideChar(s , wc, High(wc));
    if Succeeded(CLSIDFromProgID(wc, clsid)) then
      Result := s;
  end;
end;

Espero que te aporten algún beneficio o al menos te den alguna pauta para seguir, mientras tanto seguiré pensando en "la pregunta del millón".

Saludos

[[Al González]]

Qué tal, ecfisa. Me agrada que te hayas sumado a esta pesquisa.

Después de estudiar un poco más el problema, veo que conviene olvidarnos de CreateOLEObject y los ProgIDs. Verás, cuando ejecutamos la función CreateOLEObject de Delphi, estamos llamando indirectamente la función CLSIDFromProgID de la API de Windows, que como ya has visto sirve para convertir un ProgID en su respectivo GUID de clase COM (CLSID). Según la referencia técnica ésta función busca en el registro de Windows ("Looks up a CLSID in the registry, given a ProgID"), aunque seguramente es una búsqueda más eficiente que la que podríamos hacer con las funciones y clases que normalmente se usan para leer y escribir entradas del registro.

ProgIDToClassID es una envoltura Delphi de la función CLSIDFromProgID, y CreateOLEObject la usa para obtener el CLSID con el cual llamar a CoCreateInstance, la función de la API de Windows para crear una instancia de objeto COM:

Código Delphi [-]
function CreateOleObject(const ClassName: string): IDispatch;
var
  ClassID: TCLSID;
begin
  ClassID := ProgIDToClassID(ClassName);
  OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IDispatch, Result));
end;

Ahora, si examinamos cómo trabaja predeterminadamente el componente nativo TXMLDocument (del cual no quise derivar a TghXMLDoc por razones de diseño), podemos ver que éste llama a CoCreateInstance sin pasar por CreateOLEObject o ProgIDToClassID, y además hace algo como lo que aquí pretendemos: intentar la creación del objeto con diferentes versiones de MSXML:

Código Delphi [-]
const
  ...
  CLASS_DOMDocument: TGUID = '{F6D90F11-9C73-11D3-B32E-00C04F990BB4}';
  CLASS_DOMDocument26: TGUID = '{F5078F1B-C551-11D3-89B9-0000F81FE221}';
  CLASS_DOMDocument30: TGUID = '{F5078F32-C551-11D3-89B9-0000F81FE221}';
  CLASS_DOMDocument40: TGUID = '{88D969C0-F192-11D4-A65F-0040963251E5}';
  CLASS_DOMDocument60: TGUID = '{88D96A05-F192-11D4-A65F-0040963251E5}';  // No presente en Delphi 7
...
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 CreateDOMDocument: IXMLDOMDocument;
begin
  Result := TryObjectCreate([CLASS_DOMDocument60, CLASS_DOMDocument40, CLASS_DOMDocument30,
    CLASS_DOMDocument26, Winapi.msxml.CLASS_DOMDocument]) as IXMLDOMDocument;
  if not Assigned(Result) then
    raise DOMException.Create(SMSDOMNotInstalled);
end;

El secreto es que Delphi declara esas constantes TGUID, que son en sí las CLSIDs que Microsoft asignó a las distintas versiones del objeto DOMDocument de MSXML. Las CLSIDs son fijas y por tanto no necesitamos obtenerlas buscando ProgIDs en el registro de Windows, sólo conocer cuál es su valor GUID y usar éste para llamar a CoCreateInstance. Aun así podríamos buscar cada GUID en el registro antes de crear el objeto COM, pero esto no tendría mayor beneficio que intentarlo directamente, más o menos como esas funciones CreateDOMDocument y TryObjectCreate.

Esto comienza a allanar el camino. Podríamos decir que no vale la pena consultar el registro para convertir ProgIDs a CLSIDs que ya conocemos, y que TghXMLDoc debería llamar a CoCreateInstance intentando con diferentes CLSIDs. Pero todavía hay que resolver la cuestión de cuál es la mejor estrategia considerando, por ejemplo, cómo permitirle al programador indicar qué versión de MSXML debe utilizar nuestra clase o en qué orden de preferencia.

En las constantes que Delphi declara no hay una de nombre CLASS_DOMDocument50, y eso es porque la versión 5.0 de MSXML sólo puede instalarse con Microsoft Office, es decir, no es formalmente estándar en Windows. Sin embargo podría ser utilizada también en equipos que tengan ese paquete instalado. Entre sus características exclusivas, destaca por ejemplo la capacidad de hacer firma digital sobre los archivos XML, algo que por alguna razón Microsoft retiró en la versión 6.

Habiendo hecho este breve análisis, propongo que TghXMLDoc intente crear el objeto COM usando, predeterminadamente, sólo las CLSIDs CLASS_DOMDocument60, CLASS_DOMDocument40 y CLASS_DOMDocument30, en ese orden de preferencia. En esta lista predeterminada no tendría sentido contemplar versiones anteriores a la 3.0 por estar ya obsoletas. Pero sí tendrá sentido que un programador pueda indicar una versión en particular de modo expreso, cambiar el orden de preferencia o establecer su propia lista de CLSIDs.

¿Qué usar entonces?

a) parámetro(s) adicional(es) en el constructor
b) método virtual "GetCOMInstance" llamado por el constructor
c) método función virtual "COMCLSIDs" que regrese una matriz (array) de TGUIDs
d) una variable matriz global que pueda ser modificada por el programador
e) esa matriz pero como campo o propiedad de clase (no soportada en Delphi 7)
f) una combinación de los anteriores
g) otro mecanismo

Agradezco de antemano las ideas que puedan seguir aportando.

Un saludo.

[[Al González]]

Esta semana continuaré con el tema.

Empezado por Al González

Habiendo hecho este breve análisis, propongo que TghXMLDoc intente crear el objeto COM usando, predeterminadamente, sólo las CLSIDs CLASS_DOMDocument60, CLASS_DOMDocument40 y CLASS_DOMDocument30, en ese orden de preferencia. En esta lista predeterminada no tendría sentido contemplar versiones anteriores a la 3.0 por estar ya obsoletas. Pero sí tendrá sentido que un programador pueda indicar una versión en particular de modo expreso, cambiar el orden de preferencia o establecer su propia lista de CLSIDs.

¿Qué usar entonces?

a) parámetro(s) adicional(es) en el constructor
b) método virtual "GetCOMInstance" llamado por el constructor
c) método función virtual "COMCLSIDs" que regrese una matriz (array) de TGUIDs
d) una variable matriz global que pueda ser modificada por el programador
e) esa matriz pero como campo o propiedad de clase (no soportada en Delphi 7)
f) una combinación de los anteriores
g) otro mecanismo

¿Propuestas para llevar esta idea a buen puerto? Vamos, involucrarse es gratis.

[[Al González]]

Hola amigos.

Creo que ha valido la pena el trabajo de investigación y desarrollo que realicé durante las últimas semanas.

He resuelto el asunto de los identificadores de clases COM (CLSIDs) para que TghXMLDoc ya no dependa particularmente de MSXML 4.0, sino que ahora pueda usar cualquiera de las versiones vigentes de esa API que tenga el equipo donde corra la aplicación. Se descarta definitivamente (o casi) el uso de ProgIDs, ya que no es eficiente ni elegante consultar el Registro para obtener identificadores de clases que son fijos y del dominio público.

En el camino y por seguir la sana práctica de separar el código en pequeños elementos de utilidad general, escribí varias funciones y constantes que, como si fueran átomos, ayudan a formar la molécula TghXMLDoc.

En mis siguientes mensajes trataré de explicar estos cambios, pero de antemano solicito "beta testers" para esta versión candidata. Es el archivo GHFreebrary_Delphi7_20140103RC.zip del repositorio. Aunque ya realicé diversas pruebas, me gustaría someterlo al visto bueno de ustedes.

Espero sus comentarios.

Un saludo.

Al.

[Casimiro Notevi]

Gracias por compartir tanto trabajo

[[Al González]]

Empezado por Al González

¿Qué usar entonces?

a) parámetro(s) adicional(es) en el constructor
[...]
d) una variable matriz global que pueda ser modificada por el programador

Terminé aplicando esas dos opciones. Ahora explicaré a grandes rasgos los nuevos elementos involucrados en esta mejora. Agradeceré que externen la valoración que hagan de ellos, pues eso sin duda ayudará en muchos aspectos.

Primero los átomos agregados al núcleo de la biblioteca (unidad GHFRTL.pas), empezando por las nuevas constantes:

Código Delphi [-]
  Const
    { Characters }
    ghchDotDecimals = ghdgDecimals + ['.'];

ghchDotDecimals es una constante conjunto que agrupa a los 10 dígitos decimales y el punto. Es común encontrar cadenas o subcadenas formadas por una combinación de estos 11 caracteres, como es el caso de las versiones de un producto (14.8.01), visto también en el sufijo de un ProgID (ADODB.Command.2.8, Msxml2.DOMDocument.6.0). En el presente caso es utilizada por la función ghRightDigitsDots que aparece más abajo.

Código Delphi [-]
    { Empty PWideChar }
    ghEmptyPWideChr :PWideChar = '';

ghEmptyPWideChr es una constante PWideChar que indica una cadena vacía. Resulta útil para darse en lugar de Nil cuando alguna rutina espera una cadena de caracteres WideChar terminada en nulo, aunque esté vacía pero que no sea un puntero en blanco. En el presente caso es usada por la función ghPWideChr que aparece más abajo.

Código Delphi [-]
    { Class IDs }

    // MSXML.  NOTE: Versions 2.6 and earlier are obsolete.

    // MSXML2.DOMDocument.3.0
    ghciMSXMLDoc30 :TGUID = '{F5078F32-C551-11D3-89B9-0000F81FE221}';

    // MSXML2.DOMDocument.4.0
    ghciMSXMLDoc40 :TGUID = '{88D969C0-F192-11D4-A65F-0040963251E5}';

    // MSXML2.DOMDocument.5.0
    ghciMSXMLDoc50 :TGUID = '{88D969E5-F192-11D4-A65F-0040963251E5}';

    // MSXML2.DOMDocument.6.0
    ghciMSXMLDoc60 :TGUID = '{88D96A05-F192-11D4-A65F-0040963251E5}';

Las constantes ghciMSXMLDocNN contienen los identificadores de clases COM (CLSIDs) que Microsoft asignó al objeto DOMDocument de MSXML 3.0, 4.0, 5.0 y 6.0. Observen que estos identificadores son GUIDs (del tipo TGUID en Delphi) que se expresan como si fueran cadenas de 38 caracteres, pero el compilador realmente los toma como valores de 16 bytes.

Código Delphi [-]
    { MSXML Document Class IDs }
    ghMSXMLDocClassIDs :Array [0..3] Of TGUID = (
      // MSXML2.DOMDocument.3.0
      '{F5078F32-C551-11D3-89B9-0000F81FE221}',

      // MSXML2.DOMDocument.4.0
      '{88D969C0-F192-11D4-A65F-0040963251E5}',

      // MSXML2.DOMDocument.5.0
      '{88D969E5-F192-11D4-A65F-0040963251E5}',

      // MSXML2.DOMDocument.6.0
      '{88D96A05-F192-11D4-A65F-0040963251E5}');

ghMSXMLDocClassIDs es una matriz (array) unidimensional que contiene esos mismos identificadores de clases. Noten que debí poner nuevamente los cuatro valores GUIDs, toda vez que el compilador de Delphi no admite referencias a constantes tipificadas dentro de la definición de otras constantes.

Código Delphi [-]
    { MSXML Schema Cache Class IDs }
    ghMSXMLSchemaCacheClassIDs :Array [0..3] Of TGUID = (
      // MSXML2.XMLSchemaCache.3.0
      '{F5078F34-C551-11D3-89B9-0000F81FE221}',

      // MSXML2.XMLSchemaCache.4.0
      '{88D969C2-F192-11D4-A65F-0040963251E5}',

      // MSXML2.XMLSchemaCache.5.0
      '{88D969E7-F192-11D4-A65F-0040963251E5}',

      // MSXML2.XMLSchemaCache.6.0
      '{88D96A07-F192-11D4-A65F-0040963251E5}');

ghMSXMLSchemaCacheClassIDs es una matriz que lleva relación con la anterior, pero esta contiene los identificadores de clases para el objeto XMLSchemaCache, el cual se utiliza en MSXML para validar documentos contra esquemas XSD. Es importante anotar que la mencionada API no admite combinar objetos DOMDocument y XMLSchemaCache de diferentes versiones, y que TghXMLDoc previene eso mismo en su método AddSchema mostrado más abajo.

Código Delphi [-]
    { MSXML Versions }
    ghMSXMLVersions :Array [0..3] Of String = ('3.0', '4.0', '5.0', '6.0');

ghMSXMLVersions es una matriz relacionada con las anteriores dos, pero en lugar de GUIDs almacena los cuatro números de versión como simples cadenas de caracteres. La finalidad de esta matriz es permitir conocer la versión de cualquiera de los GUIDs anteriores sin tener que consultar el registro de Windows.

Ahora pasemos a las funciones átomo, también agregadas a GHFRTL.pas:

Código Delphi [-]
  { Equals? }
  Function ghEquals (Const Value1, Value2 :TGUID) :Boolean; Overload;
  Var
    GUID1 :Array [0..3] Of Integer Absolute Value1;
    GUID2 :Array [0..3] Of Integer Absolute Value2;
  Begin
    Result := (GUID1 [0] = GUID2 [0]) And (GUID1 [1] = GUID2 [1]) And
      (GUID1 [2] = GUID2 [2]) And (GUID1 [3] = GUID2 [3]);
  End;

En Delphi 7 todavía no era posible comparar dos valores TGUID usando el operador "=", y por muchos años la recomendación fue usar la función IsEqualGUID importada de OLE32.dll. Pero me surgió la pregunta: ¿qué tan eficiente será hacer una simple comparación de 16 bytes con IsEqualGUID? Por otra parte, encontré que las versiones recientes de Delphi sí admiten la comparación de TGUIDs con el operador "=". Cuando eso ocurre, el compilador inserta una llamada al método interno TGUID.Equal:

Código Delphi [-]
class operator TGUID.Equal(const Left, Right: TGUID): Boolean;
var
  a, b: PIntegerArray;
begin
  a := PIntegerArray(@Left);
  b := PIntegerArray(@Right);
  Result := (a^[0] = b^[0]) and (a^[1] = b^[1]) and (a^[2] = b^[2]) and (a^[3] = b^[3]);
end;

El cual es de cuatro a cinco veces más rápido que IsEqualGUID. Así que buscando algo similar para Delphi 7 creé esa función ghEquals, y para mi sorpresa resultó ligeramente más eficiente que el método TGUID.Equal (en Delphi 7 genera un poco menos de código máquina y en XE2 conviene añadirle la directiva InLine).

Código Delphi [-]
  { Position of GUID }
  Function ghPosGUID (Const Values :Array Of TGUID; Const ID :TGUID;
    Const StartPos :Integer = 0) :Integer;
  Begin
    For Result := StartPos To High (Values) Do
      If ghEquals (Values [Result], ID) Then
        Exit;

    Result := -1;
  End;

En GHF hay varias funciones para buscar un elemento dentro de una matriz unidimensional. Es el caso de ghPosGUID, la cual nos dice en qué posición (a partir de 0) de una matriz de GUIDs se encuentra un GUID en particular. Si devuelve -1 significa que ID no se encuentra en la matriz Values. Noten que ghPosGUID llama a ghEquals.

Código Delphi [-]
  { Valid GUIDs? }
  Function ghValidGUIDs (Const Values, IDs :Array Of TGUID) :Boolean;
  Var
    I :Integer;
  Begin
    For I := 0 To High (Values) Do
      If ghPosGUID (IDs, Values [i]) = -1 Then
      Begin
        Result := False;
        Exit;
      End;

    Result := True;
  End;

ghValidGUIDs llama a ghPosGUID con cada uno de los elementos de una matriz de GUIDs (Values) para verificar que todos ellos se encuentren incluidos en otra matriz de GUIDs (IDs). Devuelve True si se cumple la validación, o False si alguno de los elementos de Values no está en IDs.

Código Delphi [-]
  { Check MSXML Document Class IDs }
  Procedure ghCheckMSXMLDocClassIDs (Const Values :Array Of TGUID);
  Begin
    If Not ghValidGUIDs (Values, ghMSXMLDocClassIDs) Then
      ghRaise ('Invalid XML document class IDs.');
  End;

ghCheckMSXMLDocClassIDs usa la función ghValidGUIDs para verificar que todos los GUIDs dados (parámetro Values) sean identificadores de clases MSXML DOMDocument (la constante matriz ghMSXMLDocClassIDs mostrada con anterioridad). En caso de que alguno de los elementos de la matriz Values no se encuentre en la matriz ghMSXMLDocClassIDs, eleva una excepción con el procedimiento ghRaise.

Espero no se hayan cansado de leer, falta un poco más.

Código Delphi [-]
  { Create COM Object }
  Function ghCreateCOMObj (Const ClassID, IntfID :TGUID; Out Intf)
    :Integer; Overload;
  Begin
    Result := CoCreateInstance (ClassID, Nil, ClsCtx_InProc_Server Or
      ClsCtx_Local_Server, IntfID, Intf);
  End;

ghCreateCOMObj se encarga de crear una instancia de objeto COM. Es una simple envoltura de la función estándar CoCreateInstance que nos ahorra escribir el segundo y tercer parámetro de ésta última, los cuales por lo general son "Nil" y "ClsCtx_InProc_Server Or ClsCtx_Local_Server".

Código Delphi [-]
  { Set GUID }
  Function ghSetGUID (Const Ref :Pointer; Const Value :TGUID) :Boolean;
    Overload;
  Begin
    Result := Ref <> Nil;

    If Result Then
      PGUID (Ref)^ := Value;
  End;

ghSetGUID es una de esas funciones que los puristas odian por ser una especie de "If envuelto", pero que con el advenimiento de la compilación in-line se vuelven importantes para la simplificación del código fuente de las rutinas llamadoras. Recibe un puntero a TGUID (Ref) y un TGUID (Value), y si la referencia es válida le asigna éste.

Código Delphi [-]
  { COM Object }
  Function ghCOMObj (Const ClassIDs :Array Of TGUID; Const IntfID :TGUID;
    Const UsedClassID :PGUID = Nil) :IUnknown; Overload;
  Var
    Error, I :Integer;
  Begin
    Error := E_InvalidArg;  // If ClassIDs is empty

    For I := 0 To High (ClassIDs) Do
    Begin
      Error := ghCreateCOMObj (ClassIDs [i], IntfID, Result);

      If Error = S_OK Then
      Begin
        ghSetGUID (UsedClassID, ClassIDs [i]);
        Exit;
      End;
    End;

    OLEError (Error);
  End;

Haciendo uso de ghCreateCOMObj y ghSetGUID, ghCOMObj recibe una lista (matriz ClassIDs) de identificadores de clases COM e intenta crear una instancia de objeto con el primero de esos identificadores. Si no lo consigue (seguramente por no encontrarse instalada esa CLSID), entonces intenta con el segundo, y así sucesivamente, hasta lograr crear el objeto COM, el cual es regresado como resultado en forma de interfaz. Si el parámetro UsedClassID no es una referencia Nil, pone en ella el valor del GUID que tuvo éxito, es decir, la CLSID con la que finalmente se consiguió crear la instancia COM. Si no han perdido detalle de lo tratado en este hilo, lograrán adivinar que esta función es la clave para permitirle a TghXMLDoc trabajar con cualquiera de las versiones de MSXML que se tengan instaladas.

Código Delphi [-]
  { COM Dispatch }
  Function ghCOMDispatch (Const ClassIDs :Array Of TGUID;
    Const UsedClassID :PGUID = Nil) :IDispatch; Overload;
  Begin
    Result := IDispatch (ghCOMObj (ClassIDs, IDispatch, UsedClassID));
  End;

ghCOMDispatch es una envoltura de la función ghCOMObj, cuya finalidad es indicarle a CoCreateInstance que deseamos una interfaz IDispatch y obtener ese IDispatch como resultado en lugar de una interfaz genérica IUnknown. Esto es importante para lograr acceso práctico a todas las propiedades y métodos de instancias COM mediante variables OLEVariant.

Hagamos una pausa para comer...

[[Al González]]

Código Delphi [-]
  { PWideChar }
  Function ghPWideChr (Const S :WideString) :PWideChar;
  Asm
    Test EAX, EAX
    JNZ @Exit
    Mov EAX, ghEmptyPWideChr
    @Exit:
  End;

ghPWideChr es una función para convertir una cadena normal a una cadena de caracteres WideChar terminada en nulo. Eso mismo puede conseguirse con una expresión como "PWideChar (WideString (Cadena))" pero es más concisa (tanto en código fuente como en código máquina) una expresión "ghPWideChr (Cadena)".

Código Delphi [-]
  { Get Class ID }
  Function ghGetClassID (Const ProgID :String; Out ID :TGUID) :Integer;
  Begin
    Result := CLSIDFromProgID (ghPWideChr (ProgID), ID);
  End;

ghGetClassID envuelve a la función CLSIDFromProgID del sistema operativo, haciendo por nosotros la conversión del ProgID de tipo String a PWideChar (usando la función ghPWideChr). Obtiene el identificador de clase que corresponde a un ProgID dado.

Código Delphi [-]
  { Get Programmatic ID }
  Function ghGetProgID (Const ClassID :TGUID; Out ProgID :String) :Integer;
  Var
    AProgID :POLEStr;
  Begin
    Result := ProgIDFromCLSID (ClassID, AProgID);

    If Result = S_OK Then
    Begin
      ProgID := AProgID;
      CoTaskMemFree (AProgID);
    End;
  End;

ghGetProgID es la función inversa a ghGetClassID. Dado un identificador de clase (parámetro ClassID) obtiene el ProgID que le corresponde mediante la función ProgIDFromCLSID del sistema operativo.

Código Delphi [-]
  { Programmatic ID }
  Function ghProgID (Const ClassID :TGUID) :String;
  Begin
    ghGetProgID (ClassID, Result);
  End;

ghProgID envuelve a ghGetProgID con el propósito de que el resultado de la función sea el ProgID obtenido en lugar de un valor de estado. Si el CLSID dado no está en el Registro, el resultado será una cadena vacía (en virtud de que la variable Result es usada como parámetro Out para ghGetProgID).

Código Delphi [-]
  { Right Digits and Dots }
  Function ghRightDigitsDots (Const Value :String;
    Const MaxLength :Integer = MaxInt) :String;
  Begin
    Result := ghRightChrs (Value, ghchDotDecimals, MaxLength);
  End;

La función ghRightDigitsDots toma una cadena de caracteres y regresa la subcadena que en su extremo derecho se componga de dígitos decimales y puntos (dando 'MSXML2.DOMDocument.4.0' devuelve '.4.0').

Código Delphi [-]
  { Right Version }
  Function ghRightVersion (Const Value :String;
    Const MaxLength :Integer = MaxInt) :String;
  Begin
    Result := ghNotPrefixed (ghRightDigitsDots (Value, MaxLength), '.');
  End;

La función ghRightVersion, toma una cadena de caracteres y regresa la subcadena que en su extremo derecho se componga de dígitos decimales y puntos (para ello llama a ghRightDigitsDots), pero descarta el primer carácter de la subcadena en caso de ser un punto para que ésta siempre comience con número (dando 'MSXML2.DOMDocument.4.0' devuelve '4.0').

Código Delphi [-]
  { Programmatic ID Version }
  Function ghProgIDVersion (Const ClassID :TGUID) :String;
  Begin
    Result := ghRightVersion (ghProgID (ClassID));
  End;

ghProgIDVersion es una función que combina a ghProgID con ghRightVersion. Sirve para obtener la versión de un identificador de clase COM (parámetro ClassID) con base al ProgID que ese identificador tenga asociado en el registro de Windows.

Código Delphi [-]
  { Class ID }
  Function ghClassID (Const ProgID :String) :TGUID; Overload;
  Begin
    ghGetClassID (ProgID, Result);
  End;

ghClassID envuelve a ghGetClassID con el propósito de que el resultado de la función sea el identificador de clase obtenido en lugar de un valor de estado. Si el ProgID dado no está en el Registro, el resultado será un GUID en blanco (con todos sus bytes en cero).

Código Delphi [-]
  { Class ID }
  Function ghClassID (Const ProgID, Version :String) :TGUID; Overload;
  Begin
    Result := ghClassID (ghConcat (ProgID, Version, '.'));
  End;

Esta sobrecarga de ghClassID permite indicar un sufijo de versión para el ProgID dado. Si se da 'MSXML2.DOMDocument' y '6.0', se buscará el CLSID de 'MSXML2.DOMDocument.6.0'. Si se da 'MSXML2.DOMDocument' y '' (cadena vacía en el parámetro Version), se buscará el CLSID de 'MSXML2.DOMDocument'. Esto resulta útil dado que muchos ProgIDs pueden o no pueden tener un sufijo de versión.

Código Delphi [-]
  { Class ID }
  Function ghClassID (Const ProgID :String; Const VersionID :TGUID) :TGUID;
    Overload;
  Begin
    Result := ghClassID (ProgID, ghProgIDVersion (VersionID));
  End;

Esta otra sobrecarga de ghClassID es muy similar a la anterior, salvo que la cadena de versión se obtiene de un identificador de clase ya conocido (parámetro VersionID). Es decir, esta función obtiene el CLSID que corresponde a un ProgID cuya versión es igual a la del ProgID de otro CLSID. El actual código de TghXMLDoc no necesita llamar a esta sobrecarga, pero es probable que resulte útil a quienes deseen acceder a más objetos de MSXML (además de DOMDocument y XMLSchemaCache).

Código Delphi [-]
  { MSXML Schema Cache Class ID }
  Function ghMSXMLSchemaCacheClassID (Const VersionID :TGUID) :TGUID;
  Var
    I :Integer;
  Begin
    I := ghPosGUID (ghMSXMLDocClassIDs, VersionID);

    If I > -1 Then
      Result := ghMSXMLSchemaCacheClassIDs [i]
    Else
      Result := ghClassID ('MSXML2.XMLSchemaCache', VersionID);
  End;

La función ghMSXMLSchemaCacheClassID sirve para obtener el identificador de clase COM del objeto XMLSchemaCache de MSXML según la versión de otro identificador de clase COM (parámetro VersionID). El uso típico es darle uno de los CLSIDs de DOMDocument para obtener el correspondiente CLSID de XMLSchemaCache. La función llama a ghPosGUID para determinar si VersionID está en la constante matriz ghMSXMLDocClassIDs, en cuyo caso devuelve el GUID contenido en la misma posición de la constante matriz ghMSXMLSchemaCacheClassIDs. Observen que como último recurso se apoya en la función ghClassID descrita anteriormente. Usando TghXMLDoc no entrará a ese Else, a menos que el programador fuerce a la clase a usar una versión de MSXML que no sea vigente.

Código Delphi [-]
  { MSXML Schema Cache }
  Function ghMSXMLSchemaCache (Const VersionClassID :TGUID) :IDispatch;
  Begin
    Result := ghCOMDispatch (ghMSXMLSchemaCacheClassID (VersionClassID));
  End;

ghMSXMLSchemaCache combina una llamada a ghMSXMLSchemaCacheClassID con una llamada a ghCOMDispatch. Con ello crea una instancia de objeto XMLSchemaCache de la misma versión de MSXML que el CLSID indicado (parámetro VersionClassID). El método TghXMLDoc.AddSchema (mostrado más abajo) llama directamente a esta función cuando se agrega el primer esquema de validación.

Código Delphi [-]
  { MSXML Version }
  Function ghMSXMLVersion (Const ClassID :TGUID) :String;
  Var
    I :Integer;
  Begin
    I := ghPosGUID (ghMSXMLDocClassIDs, ClassID);

    If I > -1 Then
      Result := ghMSXMLVersions [i]
    Else
      Result := ghProgIDVersion (ClassID);
  End;

ghMSXMLVersion es la última de las funciones sueltas que escribí en esta fase de desarrollo. Sirve para obtener la versión de un identificador de clase MSXML según el ProgID que tenga asociado. Esta rutina, antes de apoyarse en la función ghProgIDVersion descrita líneas arriba, verifica si el CLSID dado se encuentra en la matriz ghMSXMLDocClassIDs, en cuyo caso regresa una de las cadenas de la matriz ghMSXMLVersions. De último momento, viendo su código, creo que debería hacerle una de dos cosas: a) renombrarla por "ghMSXMLDocVersion" (y que se llame sólo con CLSIDs de DOMDocument), o b) Hacer que busque también en la matriz ghMSXMLSchemaCacheClassIDs (evitando búsquedas en el Registro cuando se llame con CLSIDs de XMLSchemaCache). La necesidad de esta función surgió al agregar la propiedad Version a TghXMLDoc (ver más abajo).

[[Al González]]

Recuerden que todas las funciones y constantes descritas en las entradas anteriores (cuyos nombres inician con el prefijo gh), son elementos "sueltos" de la unidad GHFRTL, el kernel de GH Freebrary. Su uso no está restringido a la clase TghXMLDoc que les dio origen. Estos átomos pueden ser utilizados por cualquier programador para lo que guste o necesite (añadir GHFRTL al Uses), incluso para crear una clase mucho mejor y más completa que la mía, lo cual es bastante factible.

Considero una buena práctica y casi un deber moral el escribir clases, componentes o aplicaciones repartiendo el código en constantes, tipos y pequeñas funciones de uso general que no solo permitan cumplir con el objetivo particular del momento, sino que además sirvan luego para construir más clases, componentes y aplicaciones, ya sea por parte de otros programadores en su labor diaria o por uno mismo cuando haya que desarrollar la siguiente solución de software. Creo que esa es la verdadera esencia de las bibliotecas y mi manera de ampliar lo que Delphi hace por nosotros.

En seguida el código de la clase (GHFXMLDoc.pas). Observen que el constructor tiene dos sobrecargas, la primera de ellas es por si nosotros mismos queremos indicar la versión, o versiones, de MSXML a usar:

Código Delphi [-]
Doc := TghXMLDoc.Create ([ghciMSXMLDoc50]);

Aunque lo habitual será no especificar ningún CLSID y dejar que la clase lo determine:

Código Delphi [-]
Doc := TghXMLDoc.Create;

En este caso se intentará con las CLSIDs contenidas en una matriz dinámica de nombre GHXMLDocDefaultClassIDs, en la cual se establecen de forma predeterminada las GUIDs ghciMSXMLDoc60, ghciMSXMLDoc40 y ghciMSXMLDoc30 (ver sección Initialization al final de la unidad).

Código Delphi [-]
Unit GHFXMLDoc;  { XML Document }

Interface

  Type
    { XML Document class }
    TghXMLDoc = Class
      Protected
        { Fields }
        FClassID :TGUID;
        FContent :OLEVariant;
        FPath :String;
        FValidationError :OLEVariant;
        FWorkNode :OLEVariant;

        { Static methods }
        Function GetVersion :String;
        Function GetWorkLevel :Integer;
        Function GetWorkNode :OLEVariant;
        Procedure SearchError (Const Expr :String);
        Procedure SetWorkLevel (Value :Integer);
        Procedure SetWorkNode (Const Value :OLEVariant);
      Public
        Constructor Create (Const ClassIDs :Array Of TGUID;
          Const AContent :String = ''); Overload; Virtual;
        Constructor Create (Const AContent :String = ''); Overload;
          Virtual;

        { Static methods }
        Procedure AddSchema (Const NameSpace :String;
          Const Schema :OLEVariant;
          Const ValidateContent :Boolean = False); Overload;
        Procedure AddSchema (Const Schema :OLEVariant;
          Const ValidateContent :Boolean = False); Overload;
        Function CreateElement (Name :String; Const Text :String = '')
          :OLEVariant; Overload;
        Function CreateElement (Const Name, Attr :String;
          Const AttrValue :OLEVariant) :OLEVariant; Overload;
        Function CreateElement (Const Name, Text :String;
          Const Attrs :Array Of Const) :OLEVariant; Overload;
        Function CreateElement (Const Name :String;
          Const Attrs :Array Of Const) :OLEVariant; Overload;
        Function CreateElement (Const ParentLevel :Integer;
          Const Name :String; Const Text :String = '') :OLEVariant;
          Overload;
        Function CreateElement (Const ParentLevel :Integer;
          Const Name, Attr :String; Const AttrValue :OLEVariant)
          :OLEVariant; Overload;
        Function CreateElement (Const ParentLevel :Integer;
          Const Name, Text :String; Const Attrs :Array Of Const)
          :OLEVariant; Overload;
        Function CreateElement (Const ParentLevel :Integer;
          Const Name :String; Const Attrs :Array Of Const)
          :OLEVariant; Overload;
        Function FindNode (Const Expr :String) :OLEVariant; Overload;
        Function FindNode (Const Expr :String;
          Const Params :Array Of Const) :OLEVariant; Overload;
        Function FindNodes (Const Expr :String) :OLEVariant; Overload;
        Function FindNodes (Const Expr :String;
          Const Params :Array Of Const) :OLEVariant; Overload;
        Function FormatContent :String;
        Function LocateNode (Const Expr :String;
          Const RaiseError :Boolean = False) :Boolean;
        Function Node (Const Expr :String; Const Params :Array Of Const)
          :OLEVariant; Overload;
        Function Nodes (Const Expr :String; Const Params :Array Of Const)
          :OLEVariant; Overload;
        Function Validate :OLEVariant;

        { Virtual methods }
        Function Load (Const AContent :String) :Boolean; Virtual;
        Function Node (Const Expr :String) :OLEVariant; Overload; Virtual;
        Function Nodes (Const Expr :String) :OLEVariant; Overload; Virtual;
        Procedure Save (Const APath :String = ''); Virtual;

        { Properties }
        Property ClassID :TGUID Read FClassID;
        Property Content :OLEVariant Read FContent;
        Property Path :String Read FPath;
        Property ValidationError :OLEVariant Read FValidationError;
        Property Version :String Read GetVersion;
        Property WorkLevel :Integer Read GetWorkLevel Write SetWorkLevel;
        Property WorkNode :OLEVariant Read GetWorkNode Write SetWorkNode;
    End;

  Var
    { XML Document Default Class IDs }
    GHXMLDocDefaultClassIDs :Array Of TGUID;

Implementation

  Uses
    GHFRTL, Variants, MSXML, SysUtils, XMLDoc;

  { TghXMLDoc }

  Constructor TghXMLDoc.Create (Const ClassIDs :Array Of TGUID;
    Const AContent :String = '');
  Begin
    ghCheckMSXMLDocClassIDs (ClassIDs);

    { After calling ghCOMDispatch, FClassID is the class ID that this
      function used to create the FContent COM object (a DOMDocument).
      NOTE: With some versions of MSXML, it is not reliable to use
      IProvideClassInfo or IPersistStream.GetClassID to get the class ID of
      a DOMDocument instance (do not use them for that purpose). }
    FContent := ghCOMDispatch (ClassIDs, @FClassID);
    Content.Async := False;

    If (AContent <> '') And Not Load (AContent) Then
      ghRaise ('Invalid content or file for XML document.');
  End;

  Constructor TghXMLDoc.Create (Const AContent :String = '');
  Begin
    Create (GHXMLDocDefaultClassIDs, AContent);
  End;

  { Protected static methods }

  Function TghXMLDoc.GetVersion :String;
  Begin
    Result := ghMSXMLVersion (ClassID);
  End;

  Function TghXMLDoc.GetWorkLevel :Integer;
  Var
    ANode :OLEVariant;
  Begin
    ANode := WorkNode;
    Result := 0;

    While Not VarIsClear (ANode.ParentNode) Do
    Begin
      ANode := ANode.ParentNode;
      Inc (Result);
    End;
  End;

  Function TghXMLDoc.GetWorkNode :OLEVariant;
  Begin
    If VarIsClear (FWorkNode) Then
      If VarIsClear (Content.DocumentElement) Then
        FWorkNode := Content
      Else
        FWorkNode := Content.DocumentElement;

    Result := FWorkNode;
  End;

  Procedure TghXMLDoc.SearchError (Const Expr :String);
  Begin
    ghRaise ('Node(s) not found in XML document, expression: "%s".',
      [Expr]);
  End;

  Procedure TghXMLDoc.SetWorkLevel (Value :Integer);
  Begin
    If Value = WorkLevel Then
      Exit;

    Case Value Of
      0 : WorkNode := Content;
      1 : WorkNode := Content.DocumentElement;
      Else
        If Value > 0 Then
          If Value > WorkLevel Then
            ghRaise ('Can not point out a work level greater than 1 ' +
              '(%d) if current level is less than it (%d).',
              [Value, WorkLevel])
          Else
            WorkLevel := Value - WorkLevel
        Else
          While (Value < 0) And (WorkLevel > 0) Do
          Begin
            WorkNode := WorkNode.ParentNode;
            Inc (Value);
          End;
    End;
  End;

  Procedure TghXMLDoc.SetWorkNode (Const Value :OLEVariant);
  Begin
    If VarIsStr (Value) Then  // Node by expression
      FWorkNode := FindNode (Value)
    Else  // Node by automation object
      FWorkNode := IDispatch (Value);
  End;

  { Public static methods }

  Procedure TghXMLDoc.AddSchema (Const NameSpace :String;
    Const Schema :OLEVariant; Const ValidateContent :Boolean = False);
  Begin
    { NOTE: This call to VarIsNull is correct here, instead of the typical
      VarIsClear (automation/MSXML bug?). }
    If VarIsNull (Content.Schemas) Then
      Content.Schemas := ghMSXMLSchemaCache (ClassID);

    Content.Schemas.Add (NameSpace, Schema);

    If ValidateContent Then
      Validate;
  End;

  Procedure TghXMLDoc.AddSchema (Const Schema :OLEVariant;
    Const ValidateContent :Boolean = False);
  Begin
    AddSchema ('', Schema, ValidateContent);
  End;

  Function TghXMLDoc.CreateElement (Name :String; Const Text :String = '')
    :OLEVariant;
  Var
    NameSpace :String;
  Begin
    If Content.ChildNodes.Length = 0 Then
      Content.AppendChild (Content.CreateProcessingInstruction ('xml',
        'version="1.0" encoding="UTF-8"'));

    If ghIndex (Name, ' ') > 0 Then  // Name and name space
      With ghLeftRight (Name, ' ') Do
      Begin
        Name := Value1;
        NameSpace := Value2;
      End
    Else  // Name only, we use the document name space (if any)
      If Not VarIsClear (Content.DocumentElement) Then
        NameSpace := Content.DocumentElement.NameSpaceURI;

    Result := Content.CreateNode (Node_Element, Name, NameSpace);

    If Text <> '' Then
      Result.Text := Text;

    WorkNode.AppendChild (Result);
    WorkNode := Result;
  End;

  Function TghXMLDoc.CreateElement (Const Name, Attr :String;
    Const AttrValue :OLEVariant) :OLEVariant;
  Begin
    Result := CreateElement (Name);
    Result.SetAttribute (Attr, AttrValue);
  End;

  Function TghXMLDoc.CreateElement (Const Name, Text :String;
    Const Attrs :Array Of Const) :OLEVariant;
  Var
    I :Integer;
  Begin
    Result := CreateElement (Name, Text);

    For I := 0 To High (Attrs) Div 2 Do
      { NOTE: We use ghOLEVar instead of ghVar because, in Delphi 7,
        automation has a possible bug with Delphi string variants passed by
        value (SetAttribute takes the second parameter as if it were an
        empty string), even their value is internally converted to OLE
        string.  Delphi string variants passed by reference do not present
        such a problem. }
     Result.SetAttribute (ghOLEVar (Attrs [I * 2]),
       ghOLEVar (Attrs [(I * 2) + 1]));
  End;

  Function TghXMLDoc.CreateElement (Const Name :String;
    Const Attrs :Array Of Const) :OLEVariant;
  Begin
    Result := CreateElement (Name, '', Attrs);
  End;

  Function TghXMLDoc.CreateElement (Const ParentLevel :Integer;
    Const Name :String; Const Text :String = '') :OLEVariant;
  Begin
    WorkLevel := ParentLevel;
    Result := CreateElement (Name, Text);
  End;

  Function TghXMLDoc.CreateElement (Const ParentLevel :Integer;
    Const Name, Attr :String; Const AttrValue :OLEVariant) :OLEVariant;
  Begin
    WorkLevel := ParentLevel;
    Result := CreateElement (Name, Attr, AttrValue);
  End;

  Function TghXMLDoc.CreateElement (Const ParentLevel :Integer;
    Const Name, Text :String; Const Attrs :Array Of Const)
    :OLEVariant;
  Begin
    WorkLevel := ParentLevel;
    Result := CreateElement (Name, Text, Attrs);
  End;

  Function TghXMLDoc.CreateElement (Const ParentLevel :Integer;
    Const Name :String; Const Attrs :Array Of Const) :OLEVariant;
  Begin
    WorkLevel := ParentLevel;
    Result := CreateElement (Name, Attrs);
  End;

  Function TghXMLDoc.FindNode (Const Expr :String) :OLEVariant;
  Begin
    Result := Node (Expr);

    If VarIsClear (Result) Then
      SearchError (Expr);
  End;

  Function TghXMLDoc.FindNode (Const Expr :String;
    Const Params :Array Of Const) :OLEVariant;
  Begin
    Result := FindNode (Format (Expr, Params));
  End;

  Function TghXMLDoc.FindNodes (Const Expr :String) :OLEVariant;
  Begin
    Result := Nodes (Expr);

    If Result.Length = 0 Then
      SearchError (Expr);
  End;

  Function TghXMLDoc.FindNodes (Const Expr :String;
    Const Params :Array Of Const) :OLEVariant;
  Begin
    Result := FindNodes (Format (Expr, Params));
  End;

  Function TghXMLDoc.FormatContent :String;
  Begin
    Result := FormatXMLData (Content.XML);
  End;

  {$Warn No_RetVal Off}
  Function TghXMLDoc.LocateNode (Const Expr :String;
    Const RaiseError :Boolean = False) :Boolean;
  Var
    ANode :OLEVariant;
  Begin
    ANode := Node (Expr);

    If VarIsClear (ANode) Then
      If RaiseError Then
        SearchError (Expr)
      Else
        Result := False
    Else
    Begin
      WorkNode := ANode;
      Result := True;
    End;
  End;
  {$Warn No_RetVal On}

  Function TghXMLDoc.Node (Const Expr :String;
    Const Params :Array Of Const) :OLEVariant;
  Begin
    Result := Node (Format (Expr, Params));
  End;

  Function TghXMLDoc.Nodes (Const Expr :String;
    Const Params :Array Of Const) :OLEVariant;
  Begin
    Result := Nodes (Format (Expr, Params));
  End;

  Function TghXMLDoc.Validate :OLEVariant;
  Begin
    FValidationError := Content.Validate;
    Result := FValidationError;
  End;

  { Public virtual methods }

  Function TghXMLDoc.Load (Const AContent :String) :Boolean;
  Var
    Prefix :String;
  Begin
    If (AContent = '') Or (AContent [1] = '<') Then
    Begin
      Result := Content.LoadXML (AContent);  // XML text
      FPath := '';
    End
    Else  // File path
    Begin
      FPath := ghSearchPath (AContent, True);
      Result := Content.Load (FPath);

      If Not Result Then
        FPath := '';
    End;

    FWorkNode := Unassigned;

    If Result And (Content.DocumentElement.NameSpaceURI <> '') Then
    Begin
      Prefix := Content.DocumentElement.Prefix;

      If Prefix = '' Then
        { NOTE: The SelectNodes and SelectSingleNode methods of MSXML need
          that every name space in SelectionNamespaces has a prefix.  We
          use the "_" alias when the document element has no prefix. }
        Prefix := '_';

      Content.SetProperty ('SelectionNamespaces', Format ('xmlns:%s="%s"',
        [Prefix, Content.DocumentElement.NameSpaceURI]));
    End;
  End;

  Function TghXMLDoc.Node (Const Expr :String) :OLEVariant;
  Begin
    { We search from the current work node by using the given XPath
      expression.  NOTE: Expr can be a relative or absolute path. }
    Result := WorkNode.SelectSingleNode (Expr);
  End;

  Function TghXMLDoc.Nodes (Const Expr :String) :OLEVariant;
  Begin
    { We search from the current work node by using the given XPath
      expression.  NOTE: Expr can be a relative or absolute path. }
    Result := WorkNode.SelectNodes (Expr);
  End;

  Procedure TghXMLDoc.Save (Const APath :String = '');
  Var
    ExpandedPath :String;
  Begin
    If APath = '' Then
      Content.Save (Path)
    Else
    Begin
      ExpandedPath := ExpandFileName (APath);
      Content.Save (ExpandedPath);  // Exception if the Save method fails
      FPath := ExpandedPath;
    End;
  End;

Initialization
  { Preferred class IDs of MSXML DOMDocument.  NOTE: MSXML2.DOMDocument.5.0
    (ghciMSXMLDoc50) is part of Microsoft Office and not a formal Windows
    standard. }
  SetLength (GHXMLDocDefaultClassIDs, 3);
  GHXMLDocDefaultClassIDs [0] := ghciMSXMLDoc60;
  GHXMLDocDefaultClassIDs [1] := ghciMSXMLDoc40;
  GHXMLDocDefaultClassIDs [2] := ghciMSXMLDoc30;

End.

Lo único nuevo en la clase son las propiedades ClassID y Version, los constructores rehechos (conservando compatibilidad con versiones anteriores) y la adaptación del método TghXMLDoc.AddSchema. El largo pergamino de los mensajes anteriores fue para esas cuatro cosillas.

Por favor, no duden en preguntar sobre cualquier cuestión que les surja. Les recuerdo que necesito voluntarios para probar el código, más que nada para sacar nuevas ideas y perfeccionarlo entre todos. El estándar XML llegó para quedarse y cada vez se usa para más cosas. Esta humilde clase sólo es una propuesta de cómo facilitárnoslo en Delphi. Espero incluirla la semana que viene en la siguiente liberación para XE2.

¡Un abrazo!

Al González.