jvqxmltree.pas

East make Tray Icon in delphi

  Index: Integer;
begin
  Result := nil;
  if Dest = nil then
    Exit; // can not move to root
  Index := Self.ParentNode.Nodes.IndexOf(Self);
  if Index = -1 then
    Exit;
  Dest.Nodes.Add(Self);
  Self.ParentNode.Nodes.Delete(Index);
  Self.ParentNode := Dest;
  Result := Self;
end;

// removes and Frees the childnode recursively.
// returns Self when done, or nil in case of error

function TJvXMLNode.RemoveChildNode(ANode: TJvXMLNode): TJvXMLNode;
var
  Index: Integer;
begin
  Result := nil;
  Index := Nodes.IndexOf(ANode);
  if Index = -1 then
    Exit;
  Nodes.Delete(Index);
  ANode.Free;
  Result := Self;
end;

function TJvXMLNode.HasChildNodes: Boolean;
begin
  Result := Nodes.Count > 0;
end;

procedure TJvXMLNode.GetAttributeNames(AList: TStrings);
var
  I: Integer;
begin
  AList.Clear;
  for I := 0 to Attributes.Count - 1 do
    AList.Add(TJvXMLAttribute(Attributes[I]).Name);
end;

procedure TJvXMLNode.GetNodeNames(AList: TStrings);
var
  I, C: Integer;
begin
  AList.Clear;
  C := Nodes.Count;
  for I := 0 to C - 1 do
    AList.Add(TJvXMLNode(Nodes[I]).Name);
end;

function TJvXMLNode.GetNodePath: string;
var
  N: TJvXMLNode;
begin
  N := Self;
  Result := Name;
  while N.ParentNode <> nil do
  begin
    N := N.ParentNode;
    Result := N.Name + '/' + Result;
  end;
end;

// search recursively for a named node

function TJvXMLNode.FindNamedNode(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;
      Break;
    end
    else
    begin // Recurse
      Result := N.FindNamedNode(AName);
      if Result <> nil then
        Break;
    end;
  end;
end;

// add all found named Nodes to AList

procedure TJvXMLNode.FindNamedNodes(const AName: string; AList: TList);
var
  I: Integer;
  N: TJvXMLNode;
begin
  for I := 0 to Nodes.Count - 1 do
  begin
    N := TJvXMLNode(Nodes[I]);
    if N.Name = AName then
      AList.Add(N);
    // Recurse
    N.FindNamedNodes(AName, AList);
  end;
end;

// add recursively all Nodes to AList
// the list only contains pointers to the Nodes
// typecast to use, e.g. N:=TJvXMLNode(AList[0]);

procedure TJvXMLNode.GetAllNodes(AList: TList);
var
  I: Integer;
  N: TJvXMLNode;
begin
  for I := 0 to Nodes.Count - 1 do
  begin
    N := TJvXMLNode(Nodes[I]);
    AList.Add(N);
    // Recurse
    N.GetAllNodes(AList);
  end;
end;

// add recursively all Nodes with matching named attribute to AList
// the list only contains pointers to the Nodes
// typecast to use, e.g. N:=TJvXMLNode(AList[0]);

procedure TJvXMLNode.FindNamedAttributes(const AName: string; AList: TList);
var
  I: Integer;
begin
  for I := 0 to Attributes.Count - 1 do
    if TJvXMLAttribute(Attributes[I]).Name = AName then
    begin
      AList.Add(Self);
      Break;
    end;
  for I := 0 to Nodes.Count - 1 do
    TJvXMLNode(Nodes[I]).FindNamedAttributes(AName, AList);
end;

{
this procedure adds the node to AList when it matches the pattern
this will be the key procedure for XSL implementation
only basic matching is provided in the first release
path operators
 /  child path
 // recursive descent
 .  curren context or node
 @  attribute
 *  wildcar
some examples
 /  the root node only
 book/author  <author> elements that are children of <book> elements
 // the root node and all Nodes below
 //*  all element Nodes below the root node
 book//author  <author> elements that are descendants of <book> elements
 .//author  <author elements that are descendants of the current element
 *  non-root elements, irrespective of the element Name
 book/*  elements that are children of <book> elements
 book//* elements that are descendants of <book> elements
 book/*/author  <author> elements that are grandchildren of <book> elements
 book/@print_date print_date attributes that are attached to <book> elements
 */@print_date print_date atrtributes that are attached to any elements

Index can be used to specify a particular node within a matching set
 /booklist/book[0]  First <book> node in root <booklist> element
 /booklist/book[2]  Third <book> node in root <booklist> element
 /booklist/book[end()] Last <book> node in root <booklist> element
}

procedure TJvXMLNode.MatchPattern(const APattern: string; AList: TList);
begin
  // to be implemented
end;

{select a node based on path info
 e.g. booklist/book/category will find the first
 <category> that is a child of <book> that is a child of <booklist>
 }

function TJvXMLNode.SelectSingleNode(const APattern: string): TJvXMLNode;
var
  NPattern, LFilter: string;
  P, I: Integer;
  N: TJvXMLNode;
  ObjFilter: TJvXMLFilter;
begin
  Result := nil;
  if Nodes.Count = 0 then
    Exit;
  ObjFilter := nil;
  try
    P := Pos('/', APattern);
    if P = 0 then
    begin
      ObjFilter := TJvXMLFilter.Create(APattern);
      for I := 0 to Nodes.Count - 1 do
      begin
        N := TJvXMLNode(Nodes[I]);
        if N.MatchFilter(ObjFilter) then
        begin
          Result := N;
          Exit;
        end;
      end;
      // not found;
    end
    else
    begin
      LFilter := Copy(APattern, 1, P - 1);
      NPattern := Copy(APattern, P + 1, Length(APattern));
      ObjFilter := TJvXMLFilter.Create(LFilter);
      for I := 0 to Nodes.Count - 1 do
      begin
        N := TJvXMLNode(Nodes[I]);
        if N.MatchFilter(ObjFilter) then
        begin
          Result := N.SelectSingleNode(NPattern);
          if Result <> nil then
            Exit;
        end;
      end;
    end;
  finally
    ObjFilter.Free;
  end;
end;

// filter contains Name + any filters between []

function TJvXMLNode.MatchFilter(AObjFilter: TJvXMLFilter): Boolean;
var
  I, J: Integer;
  A: TJvXMLAttribute;
  N: TJvXMLNode;
  AttName: string;
  Atom: TJvXMLFilterAtom;
  AttResult: Boolean;

  function EvalAtom(const AValue: string): Boolean;
  begin
    Result := False;
    case Atom.Operator of
      xfoNOP:
        Result := True;
      xfoEQ:
        Result := AValue = Atom.Value;
      xfoIEQ:
        Result := AnsiCompareText(AValue, Atom.Value) = 0;
      xfoNE:
        Result := AValue <> Atom.Value;
      xfoINE:
        Result := AnsiCompareText(AValue, Atom.Value) <> 0;
      xfoGT:
        try
          Result := StrToFloat(AValue) > StrToFloat(Atom.Value);
        except
        end;
      xfoIGT:
        Result := AnsiCompareText(AValue, Atom.Value) > 0;
      xfoLT:
        try
          Result := StrToFloat(AValue) < StrToFloat(Atom.Value);
        except
        end;
      xfoILT:
        Result := AnsiCompareText(AValue, Atom.Value) < 0;
      xfoGE:
        try
          Result := StrToFloat(AValue) >= StrToFloat(Atom.Value);
        except
        end;
      xfoIGE:
        Result := AnsiCompareText(AValue, Atom.Value) >= 0;
      xfoLE:
        try
          Result := StrToFloat(AValue) <= StrToFloat(Atom.Value);
        except
        end;
      xfoILE:
        Result := AnsiCompareText(AValue, Atom.Value) <= 0;
    end;
  end;

begin
  Result := False;
  AttResult := False;
  if AObjFilter.Filters.Count = 0 then
  begin // just filter on Name
    Result := AObjFilter.Name = Name;
    Exit;
  end;
  for I := 0 to AObjFilter.Filters.Count - 1 do
  begin
    Atom := TJvXMLFilterAtom(AObjFilter.Filters[I]);
    if Atom.AttributeFilter then
    begin
      AttName := Atom.Name;
      if AttName = '*' then
      begin // match any attribute
        if Attributes.Count = 0 then
          Exit;
        for J := 0 to Attributes.Count - 1 do
        begin
          A := TJvXMLAttribute(Attributes[J]);
          AttResult := EvalAtom(A.Value);
          if AttResult then
            Break;
        end;
        if not AttResult then
          Exit;
      end
      else
      begin
        A := GetNamedAttribute(AttName);
        if (A = nil) or not EvalAtom(A.Value) then
          Exit;
      end;
    end
    else
    begin
      AttName := Atom.Name;
      N := GetNamedNode(AttName);
      if (N = nil) or not EvalAtom(N.Value) then
        Exit;
    end;
  end;
  Result := True;
end;

procedure TJvXMLNode.SelectNodes(APattern: string; AList: TList);
var
  NPattern: string;
  P, I: Integer;
  N: TJvXMLNode;
  LFilter: string;
  ObjFilter: TJvXMLFilter;
  Recurse: Boolean;
begin
  if Nodes.Count = 0 then
    Exit;
  if Copy(APattern, 1, 2) = '//' then
  begin //recursive
    Delete(APattern, 1, 2);
    Recurse := True;
  end
  else
    Recurse := False;
  P := Pos('/', APattern);
  if P = 0 then
  begin
    LFilter := APattern;
    ObjFilter := TJvXMLFilter.Create(LFilter);
    for I := 0 to Nodes.Count - 1 do
    begin
      N := TJvXMLNode(Nodes[I]);
      if N.MatchFilter(ObjFilter) then
        AList.Add(N)
      else
      if Recurse then
        N.SelectNodes('//' + APattern, AList);
    end;
    ObjFilter.Free;
  end
  else
  begin
    LFilter := Copy(APattern, 1, P - 1);
    if Copy(APattern, P, 2) = '//' then
      NPattern := Copy(APattern, P, Length(APattern))
    else
      NPattern := Copy(APattern, P + 1, Length(APattern));
    ObjFilter := TJvXMLFilter.Create(LFilter);
    for I := 0 to Nodes.Count - 1 do
    begin
      N := TJvXMLNode(Nodes[I]);
      if N.MatchFilter(ObjFilter) then
        N.SelectNodes(NPattern, AList)
      else
      if Recurse then
        N.SelectNodes('//' + APattern, AList);
    end;
    ObjFilter.Free;
  end;
end;

// the XSL implementation
// although this function returns a string, the string itself can be parsed to Create a DOM

function TJvXMLNode.TransformNode(AStyleSheet: TJvXMLNode): string;
begin
  // to be implemented;
  Result := AStyleSheet.Process(0, Self);
end;

// used in conjunction with the TransformNode function.
// basically works like the Document function except for Nodes with processing instructions

function TJvXMLNode.Process(ALevel: Integer; ANode: TJvXMLNode): 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 ParentNode = nil then
  begin
    for I := 0 to Nodes.Count - 1 do
      Result := Result + TJvXMLNode(Nodes[I]).Process(ALevel + 1, ANode);
    Exit;
  end;
  if ALevel > 0 then
    Indent := StringOfChar(' ', ALevel * 2)
  else
    Indent := '';
  Result := Indent + '<' + Name;
  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;
  for I := 0 to Nodes.Count - 1 do
    Result := Result + TJvXMLNode(Nodes[I]).Process(ALevel + 1, ANode);
  Result := Result + Indent + '</' + Name + '>' + sLineBreak;
end;

function TJvXMLNode.GetNameSpace: string;
var
  P: Integer;
begin
  P := Pos(':', FName);
  if P > 0 then
    Result := Copy(FName, 1, P - 1)
  else
    Result := '';
end;

// find the node with a path like customers/regional/jansoft

function TJvXMLNode.GetNamePathNode(const APath: string): TJvXMLNode;
var
  AName, NewPath, SIndex: string;
  I, P, Index, IndexC: Integer;
  N: TJvXMLNode;
begin
  Result := nil;
  if Nodes.Count = 0 then
    Exit;
  if APath = '' then
  begin
    Result := Self;
    Exit;
  end;
  P := PosStr('/', APath, 1);
  if P = 0 then
  begin
    AName := APath;
    NewPath := '';
  end
  else
  begin
    AName := Copy(APath, 1, P - 1);
    NewPath := Copy(APath, P + 1, Length(APath));
  end;
  // now check for any Index []
  P := PosStr('[', AName, 1);
  Index := 0; // search first by default
  IndexC := 0;
  if P > 0 then
  begin
    SIndex := Copy(AName, P + 1, Length(AName) - P - 1);
    AName := Copy(AName, 1, P - 1);
    if SIndex = 'end' then
      Index := -1
    else
      try
        Index := StrToInt(SIndex);
        if Index >= Nodes.Count then
          Exit;
      except
        Exit;
      end;
  end;
  if Index = -1 then // search end from end
    for I := Nodes.Count - 1 downto 0 do
    begin
      N := TJvXMLNode(Nodes[I]);
      if N.Name = AName then
        if NewPath = '' then
        begin
          Result := N;
          Exit;
        end
        else
        begin
          Result := N.GetNamePathNode(NewPath);
          Exit;
        end;
    end
  else // search from beginning indexed
    for I := 0 to Nodes.Count - 1 do
    begin
      N := TJvXMLNode(Nodes[I]);
      if N.Name = AName then
        if Index = IndexC then
        begin
          if NewPath = '' then
          begin
            Result := N;
            Exit;
          end
          else
          begin
            Result := N.GetNamePathNode(NewPath);
            Exit;
          end;
        end
        else