{*******************************************************************************
* Titel: WDOMXMLDocument
* Beschreibung: Klasse zur einfachen Umstellung von IXMLDocument auf XDOM
* Autor: Uwe Grohne (http://www.grohne.de)
* Version: 1.2.2
* Letzte Änderung: 13.05.2006
*******************************************************************************}
unit WDOMXMLDocument;

{
 If you use XDOM 3.2, leave the following DEFINE. Otherwise change it
 to XDOM_3_2!
}

{$DEFINE XDOM_3_2}

interface

uses SysUtils,Classes
{$IFDEF XDOM_3_1},XDOM_3_1{$ENDIF}
{$IFDEF XDOM_3_2},XDOM_3_2{$ENDIF}
;

type

// Forward-Deklarationen
TWDOMXMLNode = class;
// ***

TWDOMXMLNodeList = class(TObject)
   private
     FOwner: TWDOMXMLNode;
     FCount: integer;
     FNodes: array of TWDOMXMLNode;
     FNodeNames: array of String;
   public
     constructor Create(Owner:TWDOMXMLNode);
     destructor Destroy; override;
     function First:TWDOMXMLNode;
     function Last:TWDOMXMLNode;
     function GetNode(const IndexOrName: OleVariant):TWDOMXMLNode;
     function IndexOf(name:String):Integer;overload;
     function IndexOf(item:TWDOMXMLNode):Integer;overload;
     function Add(DomNode:TDomNode;DomDoc:TdomDocument):TWDOMXMLNode;
     property Nodes[const IndexOrName: OleVariant]: TWDOMXMLNode read GetNode; default;
     property Count: Integer read FCount;
     end;

TWDOMXMLNode = class(TObject)
   private
     FDomDoc:TdomDocument;
     FParentNode:TWDOMXMLNode;
     FNodeList:TWDOMXMLNodeList;
     FAttributes: TWDOMXMLNodeList;
     FNode:TDomNode;
     FNodeName:String;
     FNodeValue:String;
     function GetNodeName: String;
     procedure SetNodeName(const Value: String);
     function GetChildNodes:TWDOMXMLNodeList;
     function GetAttributeNodes: TWDOMXMLNodeList;
     function GetNextSibling: TWDOMXMLNode;
    function GetPreviousSibling: TWDOMXMLNode;
   public
     constructor Create(DomDoc:TDomDocument); overload;
     constructor Create(Name,Value:String); overload;
     destructor Destroy; override;
     procedure Assign(DomNode:TDomNode;Parent:TWDOMXMLNode);
     function GetChildValue(const IndexOrName:OleVariant):OleVariant;
     function GetText:String;
     procedure SetText(Value:String);
     function GetAttribute(const AttrName:String):OleVariant;
     procedure SetAttribute(const AttrName:String;Value:OleVariant);
     function AddChild(Name:String;Value:String=''):TWDOMXMLNode;
     function AddCDATAChild(Name:String;Value:String):TWDOMXMLNode;
     function AddAttribute(Name:String;Value:String=''):TWDOMXMLNode;
     procedure SetChildValue(const IndexOrName: OleVariant;const Value:OleVariant);
     property ChildValues[const IndexOrName:OleVariant]: OleVariant read GetChildValue write SetChildValue;
     property ChildNodes: TWDOMXMLNodeList read GetChildNodes;
     property Text: String read GetText write SetText;
     property Attributes[const AttrName: String]: OleVariant read GetAttribute write SetAttribute;
     property AttributeNodes: TWDOMXMLNodeList read GetAttributeNodes;
     property NodeName: String read GetNodeName write SetNodeName;
     property NodeValue: String read GetText write SetText;
     property NextSibling: TWDOMXMLNode read GetNextSibling;
     property PreviousSibling: TWDOMXMLNode read GetPreviousSibling;
     end;

TWDOMXMLDocument = class(TObject)
   protected
     FDocumentElement:TWDOMXMLNode;
     FXMLStrings:TStringList;
     FActive:Boolean;
     XmlToDomParser:TXmlToDomParser;
     DomImplementation:TDomImplementation;
     DomToXmlParser:TDomToXmlParser;
     DomDocument:TdomDocument;
     function GetActiveState: Boolean;
     function GetXML:TStrings;
     procedure SetXML(const Value: TStrings);
   private
     procedure SetDocumentElement(const Value: TWDOMXMLNode);
   public
     constructor Create;overload;
     constructor Create(AFilename:String);overload;
     destructor Destroy; override;
     procedure Parse(Active:Boolean);
     procedure LoadFromFile(AFileName:WideString);
     property Active: Boolean read GetActiveState write Parse;
     property XML: TStrings read GetXML write SetXML;
     property DocumentElement:TWDOMXMLNode read FDocumentElement write SetDocumentElement;
     end;

function NewXMLDocument:TWDOMXMLDocument;
function CreateElement(name,value:String):TWDOMXMLNode;
function LoadXMLDocument(AFilename:String):TWDOMXMLDocument;

implementation

uses Variants, Math;

{$IFDEF VER130}
//================= Hilfsfunktion für Delphi 6 =================================
function VarIsOrdinal(aVariant: Variant): Boolean;
begin
  result := (VarType(aVariant) and varTypeMask = varSmallInt) or
            (VarType(aVariant) and varTypeMask = varInteger) or
            (VarType(aVariant) and varTypeMask = varBoolean) or
            (VarType(aVariant) and varTypeMask = varByte);
end;
{$ENDIF}

{ TWDOMXMLNode }

//============================ Attribut einfügen ===============================
function TWDOMXMLNode.AddAttribute(Name, Value: String): TWDOMXMLNode;
var childnode:TdomAttr;
begin
childnode:= TdomAttr.create(FDomDoc,Name,true);
childnode.nodeValue:=Value;
FNode.attributes.setNamedItem(childnode);
FAttributes.Add(childnode,FDomDoc);
result:=nil;
end;

//============================ CDATA-Section einfügen ==========================
function TWDOMXMLNode.AddCDATAChild(Name, Value: String): TWDOMXMLNode;
var cdatanode:TdomCDATASection;
    childnode:TWDOMXMLNode;
begin
cdatanode:= TdomCDATASection.create(FDomDoc);
cdatanode.data := Value;
childnode:=Self.AddChild(Name);
childnode.FNode.appendChild(cdatanode);
childnode.FNodeValue:=Value;
result:=childnode;
end;

//============================ Child einfügen ==================================
function TWDOMXMLNode.AddChild(Name: String; Value:String): TWDOMXMLNode;
var childnode:TDomElement;
    childtext:TDomText;
begin
childnode:= TDomElement.create(FDomDoc,Name);
if Value<>'' then begin
   childtext:= TdomText.create(FDomDoc);
   childtext.data := Value;
   childtext.nodeValue:=Value;
   childnode.appendChild(childtext);
   end;
FNode.appendChild(childnode);
result:=FNodeList.Add(childnode,FDomDoc);
end;

//============================ Node füllen ===================================
procedure TWDOMXMLNode.Assign(DomNode: TDomNode;Parent:TWDOMXMLNode);
var child: TDomNode;
    i:integer;
begin
FNode:=DomNode;
FParentNode:=Parent;
FNodeName:=FNode.nodeName;
if FNode.nodeType=ntAttribute_Node then begin
   FNodeValue:=DomNode.nodeValue;
   Exit;
   end;
FreeAndNil(FNodeList);
FNodeList:=TWDOMXMLNodeList.Create(Self);
FreeAndNil(FAttributes);
FAttributes:=TWDOMXMLNodeList.Create(Self);
if DomNode.hasAttributes then begin
   for i:=0 to DomNode.attributes.length-1 do begin
       child:=DomNode.attributes.item(i);
       if child<>nil then
          FAttributes.Add(child,FDomDoc);
       end;
   end;

child:=DomNode.firstChild;
while (child<>nil)do begin
    if child.nodeType=ntElement_Node then
       FNodeList.Add(child,FDomDoc);
    if child.nodeType=ntText_Node then
       FNodeValue:=child.nodeValue;
    if child.nodeType=ntAttribute_Node then
       FAttributes.Add(child,FDomDoc);
    if child.nodeType=ntCDATA_Section_Node then
       FNodeValue:=(child as TdomCDATASection).data;
    child:=child.nextSibling;
    end;
end;

//============================ Node erzeugen ===================================
constructor TWDOMXMLNode.Create(DomDoc:TDomDocument);
begin
inherited Create();
FDomDoc:=DomDoc;
end;

//============================ Neues Node erzeugen =============================
constructor TWDOMXMLNode.Create(Name, Value: String);
begin
inherited Create();
FNodeName:=Name;
FNodeValue:=Value;
end;

//============================ Destruktor ======================================
destructor TWDOMXMLNode.Destroy;
begin
FreeAndNil(FNodeList);
FreeAndNil(FNode);
FreeAndNil(FAttributes);
inherited;
end;

//============================ Attribute auslesen ==============================
function TWDOMXMLNode.GetAttribute(const AttrName: String): OleVariant;
var index:integer;
begin
result:='';
index:=FAttributes.IndexOf(AttrName);
if index<>-1 then
   result:=FAttributes[index].GetText;
end;

//============================ AttributeNodes auslesen =========================
function TWDOMXMLNode.GetAttributeNodes: TWDOMXMLNodeList;
begin
result:=FAttributes;
end;

//============================ ChildNodes auslesen =============================
function TWDOMXMLNode.GetChildNodes: TWDOMXMLNodeList;
begin
if FNodeList<>nil then
   result:=FNodeList
   else
   result:=FNodeList.Create(Self);
end;

//============================ Node-Wert auslesen ==============================
function TWDOMXMLNode.GetChildValue(const IndexOrName: OleVariant): OleVariant;
begin
  Result := ChildNodes.GetNode(indexOrName).GetText;
end;

//============================= Nächstes Element zurückgeben ===================
function TWDOMXMLNode.GetNextSibling: TWDOMXMLNode;
var i:integer;
begin
result:=nil;
if FParentNode<>nil then begin
   i:=FParentNode.ChildNodes.IndexOf(Self);
   if (FParentNode.ChildNodes.Count>i+1) then
      result:=FParentNode.ChildNodes[i+1];
   end;
end;

//============================= Vorheriges Element zurückgeben =================
function TWDOMXMLNode.GetPreviousSibling: TWDOMXMLNode;
var i:integer;
begin
result:=nil;
if FParentNode<>nil then begin
   i:=FParentNode.ChildNodes.IndexOf(Self);
   if (i>0) then
      result:=FParentNode.ChildNodes[i-1];
   end;
end;

//============================= NodeName als Text auslesen ====================
function TWDOMXMLNode.GetNodeName: String;
begin
Result:=FNode.nodeName;
end;

//============================= NodeValue als Text auslesen ====================
function TWDOMXMLNode.GetText: String;
begin
if Self<>nil then
   Result:=FNodeValue
   else
   Result:='';
end;

//============================= Attribut setzen ================================
procedure TWDOMXMLNode.SetAttribute(const AttrName: String;
  Value: OleVariant);
var index:Integer;
begin
index:=FAttributes.IndexOf(AttrName);
if index=-1 then
   AddAttribute(AttrName,Value)
   else
   FAttributes[index].SetText(Value);
end;

//============================= Node-Wert setzen ===============================
procedure TWDOMXMLNode.SetChildValue(const IndexOrName, Value: OleVariant);
begin
ChildNodes.GetNode(IndexOrName).Text := Value
end;

//============================ Node-Name setzen ================================
procedure TWDOMXMLNode.SetNodeName(const Value: String);
begin
FNodeName:=Value;
end;

//============================ Node-Text setzen ================================
procedure TWDOMXMLNode.SetText(Value: String);
var childnode:TDomNode;
begin
if FNode.nodeType=ntAttribute_Node then begin
   FNode.nodeValue:=Value;
   FNodeValue:=Value;
   Exit;
   end;

childnode:=FNode.firstChild;
while childnode<>nil do begin
      if childnode.nodeType=ntText_Node then begin
         childnode.nodeValue:=Value;
         FNodeValue:=Value;
         Exit; //Verlassen, wenn gefunden
         end;
      if childnode.nodeType=ntCDATA_Section_Node then begin
         (childnode as TdomCDATASection).data:=Value;
         FNodeValue:=Value;
         Exit; //Verlassen, wenn gefunden
         end;
      childnode:=childnode.nextSibling;
      end;
childnode:= TDomText.create(FDomDoc,);
childnode.nodeValue := Value;
FNode.appendChild(childnode);
FNodeValue:=Value;
end;

{ TWDOMXMLDocument }

//============================ Konstruktor =====================================
constructor TWDOMXMLDocument.Create;
begin
inherited Create;
DomImplementation:=TDomImplementation.create(nil);
XmlToDomParser:=TXmlToDomParser.create(DomImplementation);
XmlToDomParser.BufferSize:=524288;
DomToXmlParser:=TDomToXmlParser.create(DomImplementation);
DomToXmlParser.BufferSize:=524288;
XmlToDomParser.DOMImpl:=DomImplementation;
DomToXmlParser.DOMImpl:=DomImplementation;
DomDocument:=TDomDocument.create(DomImplementation);
FXMLStrings:=TStringList.Create;
FXMLStrings.Text:=''
end;

//======================= Alt-Konstruktor für Dateiladen =======================
constructor TWDOMXMLDocument.Create(AFilename: String);
begin
Create();
LoadFromFile(AFileName);
end;


//=========================== Destruktor =======================================
destructor TWDOMXMLDocument.Destroy;
begin
FreeAndNil(FDocumentElement);
FreeAndNil(FXmlStrings);
FreeAndNil(XMLToDomParser);
FreeAndNil(DomToXMLParser);
FreeAndNil(DomImplementation);
inherited Destroy;
end;

//============================ DocumentElement zuweisen ========================
procedure TWDOMXMLDocument.SetDocumentElement(const Value: TWDOMXMLNode);
var childtext:TdomText;
begin
FDocumentElement := Value;
with FDocumentElement do begin
  if FNodeName='' then Exit;
  FDomDoc:=DomDocument;
  FNodeList:=TWDOMXMLNodeList.Create(DocumentElement);
  FNode:= TdomElement.create(DomDocument,FNodeName);
  if FNodeValue<>'' then begin
     childtext:= TdomText.create(DomDocument);
     childtext.data := FNodeValue;
     FNode.appendChild(childtext);
     end;
  end;
end;

//===================== Active-Status zurückgeben ==============================
function TWDOMXMLDocument.GetActiveState: Boolean;
begin
result:=FActive;
end;

//===================== XML-Strings zurückgeben ================================
function TWDOMXMLDocument.GetXML: TStrings;
var outstr:String;
begin
if DocumentElement<>nil then begin
   DomToXmlParser.writeToString(DocumentElement.FNode,'windows-1252',outstr);
   while (Pos(#0,outstr)>0) do
         Delete(outstr,Pos(#0,outstr),1);
   while (Pos(#$D#$D#$A,outstr)>0) do
         Delete(outstr,Pos(#$D#$D#$A,outstr),1);
   FXMLStrings.Text:=outstr;
   end;
Result:=FXMLStrings;
end;

//============================= XML-String setzen ==============================
procedure TWDOMXMLDocument.SetXML(const Value: TStrings);
begin
FXMLStrings.Assign(Value);
FActive:=false;
end;

//===================== Active=True; Parsen des XML-Textes =====================
procedure TWDOMXMLDocument.Parse(Active: Boolean);
begin
FActive:=Active;
if (not Active) or (XML.Text='') then Exit;

{$IFDEF XDOM_3_1}
DomDocument:=XmlToDomParser.parseString(XML.Text,'','',nil) As TdomDocument;
{$ELSE}
DomDocument := XmlToDomParser.StringToDom(XML.Text,'',nil,false) As TDomDocument;
{$ENDIF}
//parser.WriteDom(DomDocument);
FreeAndNil(FDocumentElement);
DocumentElement:=TWDOMXMLNode.Create(DomDocument);
DocumentElement.Assign(DomDocument.documentElement,nil);
end;

//======================= XML aus Datei laden ==================================
procedure TWDOMXMLDocument.LoadFromFile(AFileName: WideString);
begin
FXMLStrings.LoadFromFile(AFileName);
Active:=true;
end;

{ TWDOMXMLNodeList }

//===================== Node hinzufügen ========================================
function TWDOMXMLNodeList.Add(DomNode: TDomNode;DomDoc:TdomDocument):TWDOMXMLNode;
begin
Inc(FCount);
SetLength(FNodes,FCount);
SetLength(FNodeNames,FCount);
FNodes[FCount-1]:=TWDOMXMLNode.Create(DomDoc);
result:=FNodes[FCount-1];
FNodes[FCount-1].Assign(DomNode,FOwner);
FNodeNames[FCount-1]:=DomNode.nodeName;
end;

//===================== Konstruktor ============================================
constructor TWDOMXMLNodeList.Create(Owner:TWDOMXMLNode);
begin
inherited Create;
FOwner:=Owner;
FCount:=0;
end;

//========================= Destruktor =========================================
destructor TWDOMXMLNodeList.Destroy;
var i:integer;
begin
  for i:=FCount-1 downto 0 do
      FreeAndNil(FNodes[i]);
  SetLength(FNodes,0);
  inherited;
end;

//===================== Erstes Element =========================================
function TWDOMXMLNodeList.First: TWDOMXMLNode;
begin
if FCount<>0 then
   result:=Nodes[0]
   else
   result:=nil;
end;

//===================== Letztes Element ========================================
function TWDOMXMLNodeList.Last: TWDOMXMLNode;
begin
if FCount<>0 then
   result:=Nodes[FCount-1]
   else
   result:=nil;
end;

//===================== Node erreichen =========================================
function TWDOMXMLNodeList.GetNode(const IndexOrName: OleVariant): TWDOMXMLNode;
var index:integer;
begin
result:=nil;
if VarIsOrdinal(IndexOrName) then
   index:=IndexOrName
   else
   index:=IndexOf(IndexOrName);
if index<>-1 then
   Result:=FNodes[index]
   else begin
   //AutoCreate bei nicht vorhandenen Objekten
   if not VarIsOrdinal(IndexOrName) then
      result:=FOwner.AddChild(IndexOrName);
   end;
end;

//====================== Index per Name finden =================================
function TWDOMXMLNodeList.IndexOf(name: String): Integer;
var i:integer;
begin
result:=-1;
for i:=0 to FCount-1 do
    if FNodeNames[i]=name then begin
       Result:=i;
       Break;
       end;
end;

//===================== Index per Node finden ==================================
function TWDOMXMLNodeList.IndexOf(item: TWDOMXMLNode): Integer;
var i:integer;
begin
result:=-1;
for i:=0 to FCount-1 do
    if FNodes[i]=item then begin
       Result:=i;
       Break;
       end;
end;


//========================= Neues XML-Dokument erstellen =======================
function NewXMLDocument:TWDOMXMLDocument;
begin
result:=TWDOMXMLDocument.Create;
end;

//========================= XML-Dokument aus Datei laden =======================
function LoadXMLDocument(AFilename:String):TWDOMXMLDocument;
begin
result:=TWDOMXMLDocument.Create(AFilename);
end;

//========================= Neuen Node erzeugen ================================
function CreateElement(name,value:String):TWDOMXMLNode;
begin
result:=TWDOMXMLNode.Create(name,value);
end;

end.