PDA

Ver la Versión Completa : Ayuda para mejorar la clase TghXMLDoc


Al González
30-10-2013, 09:53:54
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 (http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/__GH_Freebrary__/) (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í:
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. :p

Según la hoja de ruta (http://msdn.microsoft.com/en-us/library/jj152146%28v=vs.85%29.aspx) 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 (http://www.microsoft.com/en-us/download/details.aspx?id=19662), 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 (http://msdn.microsoft.com/en-us/library/jj152146%28v=vs.85%29.aspx) 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
30-10-2013, 19:04:36
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.

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
03-11-2013, 21:18:03
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 (http://msdn.microsoft.com/en-us/library/windows/desktop/ms688386%28v=vs.85%29.aspx) é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:
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:

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ó (http://msdn.microsoft.com/en-us/library/ms753751%28v=vs.85%29.aspx) 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
25-11-2013, 20:52:49
Esta semana continuaré con el tema.
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
04-01-2014, 05:26:46
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 (http://terawiki.clubdelphi.com/Delphi/Componentes-Funciones/__GH_Freebrary__/). Aunque ya realicé diversas pruebas, me gustaría someterlo al visto bueno de ustedes.

Espero sus comentarios.

Un saludo.

Al.

Casimiro Notevi
04-01-2014, 11:43:14
Gracias por compartir tanto trabajo ^\||/

Al González
05-01-2014, 01:43:32
¿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:
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.
{ 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.
{ 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.
{ 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.
{ 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.
{ 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:
{ 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:
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).
{ 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.
{ 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.
{ 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. ;)

{ 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".
{ 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.
{ 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. :)
{ 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
05-01-2014, 05:15:42
{ 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)".
{ 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.
{ 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.
{ 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).
{ 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').
{ 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').
{ 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.
{ 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).
{ 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.
{ 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).
{ 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.
{ 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.
{ 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
05-01-2014, 06:58:13
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:
Doc := TghXMLDoc.Create ([ghciMSXMLDoc50]);
Aunque lo habitual será no especificar ningún CLSID y dejar que la clase lo determine:
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).
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. :p

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.