david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
562 lines
16 KiB
ObjectPascal
562 lines
16 KiB
ObjectPascal
unit uROMSXMLImpl;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses Classes, ActiveX, uROMSXML2_TLB, uROXMLIntf;
|
|
|
|
type TMSXMLVersion = (msxml26, msxml30, msxml40);
|
|
TMSXMLVersions = set of TMSXMLVersion;
|
|
|
|
const MSXMLFileNames : array[TMSXMLVersion] of string = ('msxml2.dll', 'msxml3.dll', 'msxml4.dll');
|
|
|
|
type { TROMSXMLNode }
|
|
TROMSXMLNode = class(TInterfacedObject, IXMLNode)
|
|
private
|
|
fNode : IXMLDOMNode;
|
|
fDoc : IXMLDocument;
|
|
|
|
protected
|
|
function GetName : widestring;
|
|
function GetLocalName : widestring;
|
|
function GetRef : pointer;
|
|
|
|
function GetParent : IXMLNode;
|
|
|
|
function GetValue : Variant;
|
|
procedure SetValue(const Value : Variant);
|
|
|
|
function GetXML : widestring;
|
|
|
|
function GetAttributes(Index : integer) : IXMLNode;
|
|
function GetAttributeCount : integer;
|
|
|
|
function GetChildren(Index : integer) : IXMLNode;
|
|
function GetChildrenCount : integer;
|
|
|
|
function Add(const aNodeName : widestring; aNameSpaceURI: widestring = '') : IXMLNode;
|
|
function AddAttribute(const anAttributeName : widestring; const anAttributeValue : Variant) : IXMLNode;
|
|
function AddXml(const Xml: widestring): IXMLNode;
|
|
|
|
procedure Delete(Index : integer);
|
|
procedure Remove(const aNode : IXMLNode);
|
|
|
|
function GetNodeByName(const aNodeName : widestring) : IXMLNode; // Returns NIL if none is found or exception. Up to you.
|
|
function GetNodeValue(const aNodeName : widestring; const Default : Variant) : Variant;
|
|
|
|
function GetAttributeByName(const anAttributeName : widestring) : IXMLNode;
|
|
function GetAttributeValue(const anAttributeName : widestring; DefaultValue : Variant) : Variant;
|
|
|
|
function GetNodesByName(const aNodeName : widestring) : IXMLNodeList; // Returns NIL if none are found or exception. Up to you.
|
|
|
|
function GetNodeByAttribute(const anAttributeName, anAttributeValue : widestring) : IXMLNode;
|
|
|
|
function GetFirstChild: IXMLNode;
|
|
function GetNextSibling: IXMLNode;
|
|
function GetNamespaceURI: WideString;
|
|
function GetDocument: IXMLDocument;
|
|
|
|
|
|
public
|
|
constructor Create(const aNode : IXMLDOMNode; aDoc: IXMLDocument);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TROMSXMLNodeList }
|
|
TROMSXMLNodeList = class(TInterfacedObject, IXMLNodeLIst)
|
|
private
|
|
fNodeList : IXMLDOMNodeList;
|
|
fDoc: IXMLDocument;
|
|
protected
|
|
function GetNodes(Index : integer) : IXMLNode;
|
|
function GetCount : integer;
|
|
|
|
public
|
|
constructor Create(const aNodeList : IXMLDOMNodeList; aDoc: IXMLDocument);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TROMSXMLDocument }
|
|
TROMSXMLDocument = class(TInterfacedObject, IXMLDocument)
|
|
private
|
|
fDocument : IXMLDOMDocument2;
|
|
|
|
protected
|
|
function GetDocumentNode : IXMLNode;
|
|
|
|
function GetEncoding : TXMLEncoding;
|
|
|
|
procedure New(aDocumentName : widestring = ''; anEncoding : TXMLEncoding = xeUTF8);
|
|
|
|
procedure SaveToStream(aStream : TStream);
|
|
procedure SaveToFile(const aFileName : string);
|
|
procedure LoadFromStream(aStream : TStream);
|
|
procedure LoadFromFile(const aFileName : string);
|
|
|
|
function GetXML:widestring;
|
|
procedure SetXML(const Value : widestring);
|
|
|
|
function Transform(const aXSL: string): string;
|
|
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
end;
|
|
|
|
var InstalledMSXMLVersions : TMSXMLVersions;
|
|
|
|
implementation
|
|
|
|
uses uRORes, uROClasses, SysUtils, ComObj, TYpInfo, Windows;
|
|
|
|
{ TROMSXMLNode }
|
|
|
|
constructor TROMSXMLNode.Create(const aNode : IXMLDOMNode; aDoc: IXMLDocument);
|
|
begin
|
|
if not Assigned(aNode)
|
|
then RaiseError(err_DOMElementIsNIL, []);
|
|
|
|
inherited Create;
|
|
|
|
fNode := aNode;
|
|
fDoc := aDoc;
|
|
end;
|
|
|
|
destructor TROMSXMLNode.Destroy;
|
|
begin
|
|
//fNode := NIL;
|
|
inherited;
|
|
end;
|
|
|
|
function TROMSXMLNode.Add(const aNodeName: widestring; aNameSpaceURI: widestring = ''): IXMLNode;
|
|
var node : IXMLDOMNode;
|
|
begin
|
|
if (aNameSpaceURI = '') and (GetNamespaceURI <> '') then aNameSpaceURI := GetNamespaceURI;
|
|
if aNameSpaceURI = '' then
|
|
begin
|
|
node := fNode.attributes.getNamedItem('xmlns');
|
|
if node <> nil then
|
|
node := fNode.ownerDocument.createNode(NODE_ELEMENT, aNodeName, node.text)
|
|
else
|
|
node := fNode.ownerDocument.createElement(aNodeName);
|
|
end
|
|
else
|
|
node := fNode.ownerDocument.createNode(NODE_ELEMENT, aNodeName, aNameSpaceURI);
|
|
fNode.appendChild(node);
|
|
|
|
result := TROMSXMLNode.Create(node, fDoc);
|
|
end;
|
|
|
|
procedure TROMSXMLNode.Delete(Index: integer);
|
|
begin
|
|
fNode.removeChild(fNode.childNodes.item[Index])
|
|
end;
|
|
|
|
function TROMSXMLNode.GetAttributes(Index : integer): IXMLNode;
|
|
begin
|
|
result := TROMSXMLNode.Create(fNode.attributes.item[Index], fDoc);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetChildren(Index : integer): IXMLNode;
|
|
begin
|
|
result := TROMSXMLNode.Create(fNode.childNodes.item[Index], fDoc)
|
|
end;
|
|
|
|
function TROMSXMLNode.GetName: widestring;
|
|
begin
|
|
result := fNode.nodeName
|
|
end;
|
|
|
|
function TROMSXMLNode.GetXML: widestring;
|
|
begin
|
|
result := fNode.XML;
|
|
end;
|
|
|
|
procedure TROMSXMLNode.Remove(const aNode: IXMLNode);
|
|
begin
|
|
fNode.removeChild(IXMLDOMNode(aNode.Ref))
|
|
end;
|
|
|
|
function TROMSXMLNode.GetValue: Variant;
|
|
begin
|
|
result := fNode.text
|
|
end;
|
|
|
|
procedure TROMSXMLNode.SetValue(const Value: Variant);
|
|
begin
|
|
fNode.text := Value
|
|
end;
|
|
|
|
function TROMSXMLNode.GetNodeByName(const aNodeName: widestring): IXMLNode;
|
|
var //list : IXMLDOMNodeList;
|
|
node : IXMLDOMNode;
|
|
begin
|
|
result := NIL;
|
|
|
|
node := fNode.selectSingleNode(aNodeName);
|
|
|
|
if (node<>NIL)
|
|
then result := TROMSXMLNode.Create(node, fDoc);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetNodeByAttribute(const anAttributeName,
|
|
anAttributeValue: widestring): IXMLNode;
|
|
var i : integer;
|
|
begin
|
|
result := NIL;
|
|
if fNode.attributes = nil then exit;
|
|
for i := 0 to (fNode.attributes.length-1) do
|
|
with fNode.attributes.item[i] do
|
|
if (nodeName=anAttributeName) and (nodeValue=anAttributeValue) then begin
|
|
result := TROMSXMLNode.Create(fNode.attributes.item[i], fDoc);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TROMSXMLNode.GetNodesByName(const aNodeName: widestring): IXMLNodeList;
|
|
var list : IXMLDOMNodeList;
|
|
begin
|
|
result := NIL;
|
|
|
|
list := fNode.selectNodes(aNodeName);
|
|
|
|
if (list<>NIL) or (list.length>0)
|
|
then result := TROMSXMLNodeList.Create(list, fDoc);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetAttributeByName(
|
|
const anAttributeName: widestring): IXMLNode;
|
|
var node : IXMLDOMNode;
|
|
begin
|
|
result := NIL;
|
|
if fNode.attributes = nil then exit;
|
|
node := fNode.attributes.getNamedItem(anAttributeName);
|
|
|
|
if (node<>NIL)
|
|
then result := TROMSXMLNode.Create(node, fDoc);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetRef: pointer;
|
|
begin
|
|
result := pointer(fNode);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetLocalName: widestring;
|
|
begin
|
|
result := fNode.baseName
|
|
end;
|
|
|
|
function TROMSXMLNode.AddAttribute(const anAttributeName : widestring;
|
|
const anAttributeValue : Variant) : IXMLNode;
|
|
var attr : IXMLDOMAttribute;
|
|
begin
|
|
attr := fNode.ownerDocument.createAttribute(anAttributeName);
|
|
attr.value := anAttributeValue;
|
|
fNode.attributes.setNamedItem(attr);
|
|
|
|
result := TROMSXMLNode.Create(attr, fDoc);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetParent: IXMLNode;
|
|
begin
|
|
result := NIL;
|
|
if (fNode.parentNode<>NIL)
|
|
then result := TROMSXMLNode.Create(fNode.parentNode, fDoc);
|
|
end;
|
|
|
|
function TROMSXMLNode.GetAttributeCount: integer;
|
|
begin
|
|
result := fNode.attributes.length
|
|
end;
|
|
|
|
function TROMSXMLNode.GetChildrenCount: integer;
|
|
begin
|
|
result := fNode.childNodes.length
|
|
end;
|
|
|
|
function TROMSXMLNode.GetAttributeValue(const anAttributeName: widestring;
|
|
DefaultValue: Variant): Variant;
|
|
var attr : IXMLNode;
|
|
begin
|
|
attr := GetAttributeByName(anAttributeName);
|
|
if (attr<>NIL) then result := attr.Value
|
|
else result := DefaultValue;
|
|
end;
|
|
|
|
function TROMSXMLNode.GetNodeValue(const aNodeName: widestring;
|
|
const Default: Variant): Variant;
|
|
var node : IXMLNode;
|
|
begin
|
|
node := GetNodeByName(aNodeName);
|
|
if (node=NIL) then result := Default
|
|
else result := node.Value;
|
|
end;
|
|
|
|
function TROMSXMLNode.GetFirstChild: IXMLNode;
|
|
var
|
|
aNode: IXMLDOMNode;
|
|
begin
|
|
aNode := fNode.firstChild;
|
|
if aNode <> nil then
|
|
Result := TROMSXMLNode.Create(aNode, fDoc)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TROMSXMLNode.GetNextSibling: IXMLNode;
|
|
var
|
|
aNode: IXMLDOMNode;
|
|
begin
|
|
aNode := fNode.nextSibling;
|
|
if aNode <> nil then
|
|
Result := TROMSXMLNode.Create(aNode, fDoc)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TROMSXMLNode.GetNamespaceURI: WideString;
|
|
begin
|
|
result := fNode.namespaceURI;
|
|
end;
|
|
|
|
function TROMSXMLNode.AddXml(const Xml: widestring): IXMLNode;
|
|
var
|
|
doc: TROMSXMLDocument;
|
|
begin
|
|
doc := TROMSXMLDocument.Create;
|
|
try
|
|
doc.New();
|
|
doc.SetXML(Xml);
|
|
if doc.fDocument.documentElement <> nil then begin
|
|
result := TROMSXMLNode.Create(fNode.appendChild(doc.fDocument.documentElement), fDoc);
|
|
end else result := nil;
|
|
finally
|
|
doc.Free;
|
|
end;
|
|
end;
|
|
|
|
function TROMSXMLNode.GetDocument: IXMLDocument;
|
|
begin
|
|
Result := fDoc;
|
|
end;
|
|
|
|
{ TROMSXMLNodeList }
|
|
|
|
constructor TROMSXMLNodeList.Create(const aNodeList: IXMLDOMNodeList; aDoc: IXMLDocument);
|
|
begin
|
|
if not Assigned(aNodeList)
|
|
then RaiseError(err_DOMElementIsNIL, []);
|
|
|
|
inherited Create;
|
|
|
|
fNodeList := aNodeList;
|
|
fDoc := aDoc;
|
|
end;
|
|
|
|
destructor TROMSXMLNodeList.Destroy;
|
|
begin
|
|
// fNodeList := NIL;
|
|
inherited;
|
|
end;
|
|
|
|
function TROMSXMLNodeList.GetCount: integer;
|
|
begin
|
|
result := fNodeList.length
|
|
end;
|
|
|
|
function TROMSXMLNodeList.GetNodes(Index: integer): IXMLNode;
|
|
begin
|
|
result := TROMSXMLNode.Create(fNodeList.item[Index], fDoc)
|
|
end;
|
|
|
|
{ TROMSXMLDocument }
|
|
|
|
constructor TROMSXMLDocument.Create;
|
|
begin
|
|
inherited Create;
|
|
fDocument := NIL;
|
|
end;
|
|
|
|
destructor TROMSXMLDocument.Destroy;
|
|
begin
|
|
fDocument := NIL;
|
|
inherited;
|
|
end;
|
|
|
|
function TROMSXMLDocument.GetDocumentNode: IXMLNode;
|
|
begin
|
|
result := TROMSXMLNode.Create(fDocument.documentElement, self)
|
|
end;
|
|
|
|
function TROMSXMLDocument.GetEncoding: TXMLEncoding;
|
|
begin
|
|
result := xeUTF8; // TODO: Complete the UTF8/16 differentiation.
|
|
end;
|
|
|
|
function TROMSXMLDocument.GetXml: widestring;
|
|
begin
|
|
result := fDocument.xml;
|
|
end;
|
|
|
|
procedure TROMSXMLDocument.LoadFromFile(const aFileName: string);
|
|
begin
|
|
if not fDocument.load(aFileName)
|
|
then with fDocument.parseError do
|
|
RaiseError(err_CannotLoadXMLDocument, [Reason, Line, linePos]);
|
|
end;
|
|
|
|
procedure TROMSXMLDocument.LoadFromStream(aStream: TStream);
|
|
var adapter : IStream;
|
|
begin
|
|
aStream.Position := 0;
|
|
adapter := TStreamAdapter.Create(aStream, soReference);
|
|
fDocument.async := FALSE;
|
|
if not fDocument.load(adapter) then
|
|
with fDocument.parseError do
|
|
RaiseError(err_CannotLoadXMLDocument, [Reason, Line, linePos]);
|
|
end;
|
|
|
|
procedure TROMSXMLDocument.New(aDocumentName : widestring = ''; anEncoding : TXMLEncoding = xeUTF8);
|
|
var
|
|
lPi: IXMLDOMProcessingInstruction;
|
|
begin
|
|
{ !!! IMPORTANT !!!
|
|
|
|
If you get an exception saying "CoInitialize has not been called" make sure the unit
|
|
uROCOMInit.pas is included in *and* is the FIRST UNIT of your DPR file.
|
|
|
|
For example:
|
|
|
|
program NewProject;
|
|
|
|
uses
|
|
uROCOMInit, <--- HERE!!!
|
|
Forms,
|
|
[..]
|
|
}
|
|
|
|
try
|
|
if msxml40 in InstalledMSXMLVersions
|
|
then fDocument := CoDOMDocument40.Create // See note above in case of an exception here
|
|
|
|
else if msxml30 in InstalledMSXMLVersions
|
|
then fDocument := CoDOMDocument30.Create // See note above in case of an exception here
|
|
|
|
else if msxml26 in InstalledMSXMLVersions
|
|
then fDocument := CoDOMDocument26.Create // See note above in case of an exception here
|
|
|
|
else RaiseError(err_NoXMLParsersAvailable, []);
|
|
|
|
fDocument.async := false;
|
|
|
|
except
|
|
on E:Exception do RaiseError(err_ErrorCreatingMsXmlDoc,[E.ClassName, E.Message]);
|
|
else raise;
|
|
end;
|
|
|
|
if (aDocumentName<>'')
|
|
then fDocument.documentElement := fDocument.createElement(aDocumentName);
|
|
if anEncoding = xeUTF8 then
|
|
lpi := fDocument.createProcessingInstruction('xml', 'version="1.0" encoding="utf-8"')
|
|
else
|
|
lpi := fDocument.createProcessingInstruction('xml', 'version="1.0" encoding="utf-16"');
|
|
fDocument.insertBefore(lpi, fDocument.childNodes[0]);
|
|
fDocument.preserveWhiteSpace := true;
|
|
fDocument.resolveExternals := false;
|
|
fDocument.validateOnParse := false;
|
|
end;
|
|
|
|
procedure TROMSXMLDocument.SaveToFile(const aFileName: string);
|
|
begin
|
|
fDocument.save(aFileName);
|
|
end;
|
|
|
|
procedure TROMSXMLDocument.SaveToStream(aStream: TStream);
|
|
var adapter : IStream;
|
|
begin
|
|
adapter := TStreamAdapter.Create(aStream, soReference);
|
|
fDocument.save(adapter);
|
|
end;
|
|
|
|
function DetectMSXMLVersions : TMSXMLVersions;
|
|
var sysdir : array[0..199] of char;
|
|
ver : TMSXMLVersion;
|
|
begin
|
|
result := [];
|
|
|
|
GetSystemDirectory(sysdir, SizeOf(sysdir));
|
|
|
|
for ver := Low(TMSXMLVersion) to High(TMSXMLVersion) do
|
|
if FileExists(sysdir+'\'+MSXMLFileNames[ver])
|
|
then result := result+[ver];
|
|
end;
|
|
|
|
procedure TROMSXMLDocument.SetXML(const Value: widestring);
|
|
begin
|
|
if not fDocument.loadXML(Value) then
|
|
raise Exception.Create('Invalid input');
|
|
end;
|
|
|
|
const MSXMLDOM_Name = 'Msxml2.DOMDocument.3.0';
|
|
|
|
function TROMSXMLDocument.Transform(const aXSL: string): string;
|
|
var
|
|
XSLStylesheet: IXMLDOMDocument2;
|
|
XSLTemplate: IXSLTemplate;
|
|
XSLProcessor: IXSLProcessor;
|
|
adapter : IStream;
|
|
aStream: TStringStream;
|
|
begin
|
|
result := '';
|
|
|
|
XSLStylesheet := CoFreeThreadedDomDocument.Create;
|
|
XSLStylesheet.Async := FALSE;
|
|
if not XSLStylesheet.loadXML(aXSL)
|
|
then raise exception.create('Couldn''t load XSL stylesheet');
|
|
|
|
XSLTemplate := CoXSLTemplate.Create;
|
|
XSLTemplate._Set_stylesheet(XSLStylesheet);
|
|
|
|
XSLProcessor := XSLTemplate.createprocessor;
|
|
XSLProcessor.input := fDocument;
|
|
|
|
aStream := TStringStream.Create('');
|
|
try
|
|
adapter := TStreamAdapter.Create(aStream, soReference);
|
|
XSLProcessor.output := adapter;
|
|
if XSLProcessor.Transform
|
|
then result := aStream.DataString;
|
|
finally
|
|
adapter:=nil;
|
|
aStream.Free;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
// Removed in favour of the unit uROCOMInit.pas which has to be added as first unit to the project's DPR
|
|
// See http://www.devexpress.com/products/vcl/ewf/faq.asp#A8 for more info
|
|
|
|
// CoInitializeEx(nil, COINIT_MULTITHREADED or COINIT_SPEED_OVER_MEMORY);
|
|
|
|
InstalledMSXMLVersions := DetectMSXMLVersions;
|
|
|
|
finalization
|
|
// CoUninitialize;
|
|
|
|
end.
|