jvqxmltree.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvXMLTree.PAS, released on 2002-06-15.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQXmlTree.pas,v 1.17 2004/09/07 23:11:37 asnepvangers Exp $

unit JvQXmlTree;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes,
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  JvQStrings;

type
  TJvXMLValueType = (xvtString, xvtCDATA);
  TJvXMLFilterOperator = (xfoNOP, xfoEQ, xfoIEQ, xfoNE, xfoINE, xfoGE,
    xfoIGE, xfoLE, xfoILE, xfoGT, xfoIGT, xfoLT, xfoILT);

  TJvXMLTree = class;

  TJvXMLFilterAtom = class(TObject)
  private
    FValue: string;
    FName: string;
    FOperator: TJvXMLFilterOperator;
    FAttributeFilter: Boolean;
  public
    property Name: string read FName write FName;
    property Operator: TJvXMLFilterOperator read FOperator write FOperator;
    property Value: string read FValue write FValue;
    property AttributeFilter: Boolean read FAttributeFilter write FAttributeFilter;
  end;

  TJvXMLFilter = class(TObject)
  private
    FName: string;
    FFilters: TList;
    procedure Initialize(FilterStr: string);
  public
    constructor Create(const FilterStr: string);
    destructor Destroy; override;
    property Name: string read FName write FName;
    property Filters: TList read FFilters write FFilters;
  end;

  TJvXMLNode = class;

  TJvXMLAttribute = class(TObject)
  private
    FName: string;
    FValue: Variant;
    FParent: TJvXMLNode;
  public
    constructor Create(AParent: TJvXMLNode; const AName: string; AValue: Variant);
    function Document: string;
    property Name: string read FName write FName;
    property Value: Variant read FValue write FValue;
    property Parent: TJvXMLNode read FParent write FParent;
  end;

  TJvXMLNode = class(TObject)
  private
    FName: string;
    FValue: Variant;
    FNodes: TList;
    FAttributes: TList;
    FParentNode: TJvXMLNode;
    FValueType: TJvXMLValueType;
  public
    constructor Create(const AName: string; AValue: Variant; AParent: TJvXMLNode);
    destructor Destroy; override;
    // added 29-July-2000
    function GetNamePathNode(const APath: string): TJvXMLNode;
    procedure DeleteNamePathNode(const APath: string);
    function ForceNamePathNode(const APath: string): TJvXMLNode;
    function GetNamePathNodeAttribute(const APath, AName: string): TJvXMLAttribute;
    procedure DeleteNamePathNodeAttribute(const APath, AName: string);
    function ForceNamePathNodeAttribute(const APath, AName: string; AValue: Variant): TJvXMLAttribute;
    function AddNode(const AName: string; AValue: Variant): TJvXMLNode;
    function AddNodeEx(const AName: string; AValue: Variant): TJvXMLNode;
    procedure DeleteNode(Index: Integer);
    procedure ClearNodes;
    function AddAttribute(const AName: string; AValue: Variant): TJvXMLAttribute;
    function GetAttributeValue(const AName: string): Variant;
    procedure DeleteAttribute(Index: Integer);
    procedure ClearAttributes;
    function Document(ALevel: Integer): string;
    function GetNodePath: string;
    function GetNamedNode(const AName: string): TJvXMLNode;
    function SelectSingleNode(const APattern: string): TJvXMLNode;
    procedure SelectNodes(APattern: string; AList: TList);
    function TransformNode(AStyleSheet: TJvXMLNode): string;
    function Process(ALevel: Integer; ANode: TJvXMLNode): string;
    function FindNamedNode(const AName: string): TJvXMLNode;
    procedure FindNamedNodes(const AName: string; AList: TList);
    procedure GetAllNodes(AList: TList);
    function GetNamedAttribute(const AName: string): TJvXMLAttribute;
    procedure FindNamedAttributes(const AName: string; AList: TList);
    function MatchFilter(AObjFilter: TJvXMLFilter): Boolean;
    procedure MatchPattern(const APattern: string; AList: TList);
    procedure GetNodeNames(AList: TStrings);
    procedure GetAttributeNames(AList: TStrings);
    function GetNameSpace: string;
    function HasChildNodes: Boolean;
    function CloneNode: TJvXMLNode;
    function FirstChild: TJvXMLNode;
    function LastChild: TJvXMLNode;
    function PreviousSibling: TJvXMLNode;
    function NextSibling: TJvXMLNode;
    function MoveAddNode(Dest: TJvXMLNode): TJvXMLNode;
    function MoveInsertNode(Dest: TJvXMLNode): TJvXMLNode;
    function RemoveChildNode(ANode: TJvXMLNode): TJvXMLNode;
    property Name: string read FName write FName;
    property Value: Variant read FValue write FValue;
    property ValueType: TJvXMLValueType read FValueType write FValueType;
    property Nodes: TList read FNodes write FNodes;
    property ParentNode: TJvXMLNode read FParentNode write FParentNode;
    property Attributes: TList read FAttributes write FAttributes;
  end;

  TJvXMLTree = class(TJvXMLNode)
  private
    FLines: TStringList;
    FNodeCount: Integer;
    function GetLines: TStrings;
    procedure SetLines(const Value: TStrings);
    function GetText: string;
    procedure SetText(const Value: string);
  public
    constructor Create(const AName: string; AValue: Variant; AParent: TJvXMLNode);
    destructor Destroy; override;
    procedure ParseXML;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    function AsText: string;
    property Lines: TStrings read GetLines write SetLines;
    property NodeCount: Integer read FNodeCount;
    property Text: string read GetText write SetText;
  end;

procedure PreProcessXML(AList: TStrings);

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQConsts;

procedure PreProcessXML(AList: TStrings);
var
  OList: TStringList;
  S, xTag, xText, xData: string;
  P1, P2, C: Integer;
  //Level: Integer;

  function Clean(const AText: string): string;
  begin
    Result := StringReplace(AText, sLineBreak, ' ', [rfReplaceAll]);
    Result := StringReplace(Result, Tab, ' ', [rfReplaceAll]);
    Result := Trim(Result);
  end;

  function CleanCDATA(const AText: string): string;
  begin
    Result := StringReplace(AText, sLineBreak, '\n ', [rfReplaceAll]);
    Result := StringReplace(Result, Tab, '\t ', [rfReplaceAll]);
  end;

begin
  OList := TStringList.Create;
  try
    S := AList.Text;
    xText := '';
    xTag := '';
    P1 := 1;
    C := Length(S);
    //Level := 0;
    repeat
      P2 := PosStr('<', S, P1);
      if P2 > 0 then
      begin
        xText := Trim(Copy(S, P1, P2 - P1));
        if xText <> '' then
          OList.Add('TX:' + Clean(xText));
        P1 := P2;
        // check for CDATA
        if UpperCase(Copy(S, P1, 9)) = '<![CDATA[' then
        begin
          P2 := PosStr(']]>', S, P1);
          xData := Copy(S, P1 + 9, P2 - P1 - 9);
          OList.Add('CD:' + CleanCDATA(xData));
          P1 := P2 + 2;
        end
        else
        begin
          P2 := PosStr('>', S, P1);
          if P2 > 0 then
          begin
            xTag := Copy(S, P1 + 1, P2 - P1 - 1);
            P1 := P2;
            if xTag[1] = '/' then
            begin
              Delete(xTag, 1, 1);
              OList.Add('CT:' + Clean(xTag));
              //Dec(Level);
            end
            else
            if xTag[Length(xTag)] = '/' then
              OList.Add('ET:' + Clean(xTag))
            else
            begin
              //Inc(Level);
              OList.Add('OT:' + Clean(xTag));
            end;
          end;
        end;
      end
      else
      begin
        xText := Trim(Copy(S, P1, Length(S)));
        if xText <> '' then
        begin
          OList.Add('TX:' + Clean(xText));
        end;
        P1 := C;
      end;
      Inc(P1);
    until P1 > C;
    AList.Assign(OList);
  finally
    OList.Free;
  end;
end;

//=== { TJvXMLNode } =========================================================

constructor TJvXMLNode.Create(const AName: string; AValue: Variant; AParent: TJvXMLNode);
begin
  inherited Create;
  FNodes := TList.Create;
  FName := AName;
  FValue := AValue;
  FValueType := xvtString;
  FParentNode := AParent;
  FAttributes := TList.Create;
end;

destructor TJvXMLNode.Destroy;
begin
  ClearNodes;
  FNodes.Free;
  ClearAttributes;
  FAttributes.Free;
  inherited Destroy;
end;

function TJvXMLNode.AddAttribute(const AName: string; AValue: Variant): TJvXMLAttribute;
begin
  Result := TJvXMLAttribute.Create(Self, AName, AValue);
  Attributes.Add(Result);
end;

function TJvXMLNode.AddNode(const AName: string; AValue: Variant): TJvXMLNode;
begin
  Result := TJvXMLNode.Create(AName, AValue, Self);
  Nodes.Add(Result);
end;

// adds node and parses any attributes;

function TJvXMLNode.AddNodeEx(const AName: string; AValue: Variant): TJvXMLNode;
var
  S, SN, SV: string;
  C, P1, P2: Integer;
begin
  Result := TJvXMLNode.Create(AName, AValue, Self);
  Self.Nodes.Add(Result);
  C := Length(AName);
  //first parse Name
  P1 := PosStr(' ', AName, 1);
  if P1 = 0 then
    Exit;
  S := Copy(AName, 1, P1 - 1);
  Result.Name := S;
  repeat
    // find '='
    P2 := PosStr('=', AName, P1);
    if P2 = 0 then
      Break;
    SN := Trim(Copy(AName, P1, P2 - P1));
    P1 := P2;
    // find begin of value
    P1 := PosStr('"', AName, P1);
    if P1 = 0 then
      Break;
    P2 := PosStr('"', AName, P1 + 1);
    if P2 = 0 then
      Exit;
    SV := Copy(AName, P1 + 1, P2 - P1 - 1);
    Result.AddAttribute(SN, SV);
    P1 := P2 + 1;
  until P1 > C;
end;

function TJvXMLNode.GetNamedAttribute(const AName: string): TJvXMLAttribute;
var
  I: Integer;
  N: TJvXMLAttribute;
begin
  Result := nil;
  for I := 0 to Attributes.Count - 1 do
  begin
    N := TJvXMLAttribute(Attributes[I]);
    if N.Name = AName then
    begin
      Result := N;
      Break;
    end;
  end;
end;

procedure TJvXMLNode.ClearAttributes;
var
  I: Integer;
begin
  if Attributes.Count <> 0 then
  begin
    for I := 0 to Attributes.Count - 1 do
      TJvXMLAttribute(Attributes[I]).Free;
    Attributes.Clear;
  end;
end;

procedure TJvXMLNode.ClearNodes;
var
  I: Integer;
begin
  for I := 0 to Nodes.Count - 1 do
    TJvXMLNode(Nodes[I]).Free;
  Nodes.Clear;
end;

procedure TJvXMLNode.DeleteAttribute(Index: Integer);
begin
  if (Attributes.Count > 0) and (Index < Attributes.Count) then
  begin
    TJvXMLAttribute(Attributes[Index]).Free;
    Attributes.Delete(Index);
  end;
end;

procedure TJvXMLNode.DeleteNode(Index: Integer);
begin
  if (Nodes.Count > 0) and (Index < Nodes.Count) then
  begin
    TJvXMLNode(Nodes[Index]).Free;
    Nodes.Delete(Index);
  end;
end;

function TJvXMLNode.Document(ALevel: Integer): string;
var
  I: Integer;
  Indent: string;

  function ExpandCDATA(const AValue: string): string;
  begin
    Result := StringReplace(AValue, '\n ', sLineBreak, [rfReplaceAll]);
    Result := StringReplace(Result, '\t ', Tab, [rfReplaceAll]);
  end;

begin
  if ALevel > 0 then
    Indent := StringOfChar(' ', ALevel * 2)
  else
    Indent := '';
  Result := Indent + '<' + Name;
  if Attributes.Count > 0 then
    for I := 0 to Attributes.Count - 1 do
      Result := Result + TJvXMLAttribute(Attributes[I]).Document;
  if (Nodes.Count = 0) and (Value = '') then
  begin
    Result := Result + ' />' + sLineBreak;
    Exit;
  end
  else
    Result := Result + '>' + sLineBreak;
  if Value <> '' then
  begin
    if ValueType = xvtString then
      Result := Result + Indent + '  ' + Value + sLineBreak
    else
    if ValueType = xvtCDATA then
      Result := Result + Indent + '  ' + '<![CDATA[' + ExpandCDATA(Value) + ']]>' + sLineBreak;
  end;
  if Nodes.Count <> 0 then
    for I := 0 to Nodes.Count - 1 do
      Result := Result + TJvXMLNode(Nodes[I]).Document(ALevel + 1);
  Result := Result + Indent + '</' + Name + '>' + sLineBreak;
end;

// duplicates a node recursively

function TJvXMLNode.CloneNode: TJvXMLNode;
var
  I: Integer;
  N: TJvXMLNode;
begin
  Result := TJvXMLNode.Create(Name, Value, nil);
  Result.Name := Name;
  Result.Value := Value;
  if Attributes.Count > 0 then
    for I := 0 to Attributes.Count - 1 do
      Result.AddAttribute(TJvXMLAttribute(Attributes[I]).Name, TJvXMLAttribute(Attributes[I]).Value);
  if Nodes.Count > 0 then
    for I := 0 to Nodes.Count - 1 do
    begin
      N := TJvXMLNode(Nodes[I]).CloneNode;
      Result.Nodes.Add(N);
    end;
end;

function TJvXMLNode.GetNamedNode(const AName: string): TJvXMLNode;
var
  I: Integer;
  N: TJvXMLNode;
begin
  Result := nil;
  for I := 0 to Nodes.Count - 1 do
  begin
    N := TJvXMLNode(Nodes[I]);
    if N.Name = AName then
    begin
      Result := N;
      Exit;
    end;
  end;
end;

function TJvXMLNode.FirstChild: TJvXMLNode;
begin
  if Nodes.Count > 0 then
    Result := TJvXMLNode(Nodes[0])
  else
    Result := nil;
end;

function TJvXMLNode.LastChild: TJvXMLNode;
begin
  if Nodes.Count > 0 then
    Result := TJvXMLNode(Nodes[Nodes.Count - 1])
  else
    Result := nil;
end;

function TJvXMLNode.NextSibling: TJvXMLNode;
var
  Index: Integer;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  Index := ParentNode.Nodes.IndexOf(Self);
  if Index = -1 then
    Exit;
  if Index < ParentNode.Nodes.Count - 1 then
    Result := TJvXMLNode(ParentNode.Nodes[Index + 1]);
end;

function TJvXMLNode.PreviousSibling: TJvXMLNode;
var
  Index: Integer;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  Index := ParentNode.Nodes.IndexOf(Self);
  if Index = -1 then
    Exit;
  if Index > 0 then
    Result := TJvXMLNode(ParentNode.Nodes[Index - 1]);
end;
// moves a node to a new location

function TJvXMLNode.MoveInsertNode(Dest: TJvXMLNode): TJvXMLNode;
var
  Index1, Index2: Integer;
begin
  Result := nil;
  if Dest.ParentNode = nil then
    Exit; // can not move to root
  Index1 := Self.ParentNode.Nodes.IndexOf(Self);
  if Index1 = -1 then
    Exit;
  Index2 := Dest.ParentNode.Nodes.IndexOf(Dest);
  if Index2 = -1 then
    Exit;
  Dest.ParentNode.Nodes.Insert(Index2, Self);
  Self.ParentNode.Nodes.Delete(Index1);
  Self.ParentNode := Dest.ParentNode;
  Result := Self;
end;

function TJvXMLNode.MoveAddNode(Dest: TJvXMLNode): TJvXMLNode;
var