jvqxmltree.pas

East make Tray Icon in delphi

          Inc(IndexC);
    end;
end;

function TJvXMLNode.ForceNamePathNode(const APath: string): TJvXMLNode;
var
  AName, NewPath: string;
  I, P: Integer;
  N: TJvXMLNode;
  DoAppend: Boolean;
begin
  //  Result:=nil;
  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;
  P := PosStr('+', AName, 1);
  if P > 0 then
    Delete(AName, P, 1);
  DoAppend := P > 0;
  if not DoAppend then
    for I := 0 to Nodes.Count - 1 do
    begin
      N := TJvXMLNode(Nodes[I]);
      if N.Name = AName then
        if NewPath = '' then
        begin
          Result := N;
          Exit;
        end
        else
        begin
          Result := N.ForceNamePathNode(NewPath);
          Exit;
        end;
    end;
  // we dont have it , so force it;
  N := TJvXMLNode.Create(AName, '', Self);
  Nodes.Add(N);
  if NewPath = '' then
    Result := N
  else
    Result := N.ForceNamePathNode(NewPath);
end;

function TJvXMLNode.ForceNamePathNodeAttribute(const APath, AName: string;
  AValue: Variant): TJvXMLAttribute;
var
  N: TJvXMLNode;
  A: TJvXMLAttribute;
begin
  Result := nil;
  N := ForceNamePathNode(APath);
  if N = nil then
    Exit;
  A := N.GetNamedAttribute(AName);
  if A <> nil then
  begin
    A.Value := AValue;
    Result := A;
  end
  else
    Result := N.AddAttribute(AName, AValue);
end;

function TJvXMLNode.GetNamePathNodeAttribute(const APath, AName: string): TJvXMLAttribute;
var
  N: TJvXMLNode;
begin
  Result := nil;
  N := GetNamePathNode(APath);
  if N = nil then
    Exit;
  Result := N.GetNamedAttribute(AName);
end;

procedure TJvXMLNode.DeleteNamePathNode(const APath: string);
var
  N, PN: TJvXMLNode;
  I: Integer;
begin
  if APath = '' then
    Exit;
  N := GetNamePathNode(APath);
  if N = nil then
    Exit;
  PN := N.ParentNode;
  for I := 0 to PN.Nodes.Count - 1 do
    if TJvXMLNode(PN.Nodes[I]) = N then
    begin
      PN.DeleteNode(I);
      Exit;
    end;
end;

procedure TJvXMLNode.DeleteNamePathNodeAttribute(const APath, AName: string);
var
  A: TJvXMLAttribute;
  PN: TJvXMLNode;
  I: Integer;
begin
  A := GetNamePathNodeAttribute(APath, AName);
  if A = nil then
    Exit;
  PN := A.Parent;
  for I := 0 to PN.Attributes.Count - 1 do
    if TJvXMLAttribute(PN.Attributes[I]) = A then
    begin
      PN.DeleteAttribute(I);
      Exit;
    end;
end;

function TJvXMLNode.GetAttributeValue(const AName: string): Variant;
var
  I: Integer;
  A: TJvXMLAttribute;
begin
  Result := Null;
  for I := 0 to Attributes.Count - 1 do
  begin
    A := TJvXMLAttribute(Attributes[I]);
    if A.Name = AName then
    begin
      Result := A.Value;
      Exit;
    end;
  end;
end;

//=== { TJvXMLTree } =========================================================

constructor TJvXMLTree.Create(const AName: string; AValue: Variant; AParent: TJvXMLNode);
begin
  inherited Create(AName, AValue, AParent);
  FLines := TStringList.Create;
end;

destructor TJvXMLTree.Destroy;
begin
  FLines.Free;
  inherited Destroy;
end;

function TJvXMLTree.AsText: string;
var
  I: Integer;
begin
  if Nodes.Count = 0 then
    Exit;
  Result := '<' + Name;
  if Attributes.Count > 0 then
    for I := 0 to Attributes.Count - 1 do
      Result := Result + TJvXMLAttribute(Attributes[I]).Document;
  Result := Result + '>' + sLineBreak;
  for I := 0 to Nodes.Count - 1 do
    Result := Result + TJvXMLNode(Nodes[I]).Document(1);
  Result := Result + '</' + Name + '>' + sLineBreak;
end;

procedure TJvXMLTree.SaveToFile(const FileName: string);
begin
  Lines.Text := Text;
  Lines.SaveToFile(FileName);
end;

function TJvXMLTree.GetLines: TStrings;
begin
  Result := FLines;
end;

procedure TJvXMLTree.SetLines(const Value: TStrings);
begin
  FLines.Assign(Value);
end;

procedure TJvXMLTree.LoadFromStream(Stream: TStream);
begin
  ClearNodes;
  ClearAttributes;
  Lines.LoadFromStream(Stream);
  PreProcessXML(Lines);
  ParseXML;
end;

procedure TJvXMLTree.SaveToStream(Stream: TStream);
begin
  Lines.Text := AsText;
  Lines.SaveToStream(Stream);
end;

function TJvXMLTree.GetText: string;
var
  I: Integer;
begin
  //  Result:='<'+Name;
  //  if Attributes.Count>0 then
  //  for I:=0 to Attributes.Count-1 do
  //    Result:=Result+TJvXMLAttribute(Attributes[I]).Document;
  //  Result:=Result+'>'+sLineBreak;
  Result := '';
  for I := 0 to Nodes.Count - 1 do
    Result := Result + TJvXMLNode(Nodes[I]).Document(0);
  //  Result:=Result+'</'+Name+'>'+sLineBreak;
end;

procedure TJvXMLTree.SetText(const Value: string);
begin
  ClearNodes;
  ClearAttributes;
  Lines.Text := Value;
  PreProcessXML(Lines);
  ParseXML;
end;

//=== { TJvXMLAttribute } ====================================================

constructor TJvXMLAttribute.Create(AParent: TJvXMLNode; const AName: string; AValue: Variant);
begin
  inherited Create;
  FName := AName;
  FValue := AValue;
  FParent := AParent;
end;

function TJvXMLAttribute.Document: string;
var
  S: string;
begin
  S := Value;
  Result := ' ' + Name + '="' + S + '"';
end;

//=== { TJvXMLTree } =========================================================

procedure TJvXMLTree.ParseXML;
var
  I, C: Integer;
  S, Token, AName: string;
  N: TJvXMLNode;
begin
  I := 0;
  FNodeCount := 0;
  ClearNodes;
  ClearAttributes;
  Name := 'root';
  N := Self;
  C := Lines.Count - 1;
  repeat
    S := Lines[I];
    Token := Copy(S, 1, 3);
    AName := Copy(S, 4, Length(S));
    if Token = 'OT:' then
    begin
      N := N.AddNodeEx(AName, '');
      Inc(FNodeCount);
    end
    else
    if Token = 'CT:' then
      N := N.ParentNode
    else
    if Token = 'ET:' then
      N.AddNodeEx(AName, '')
    else
    if Token = 'TX:' then
    begin
      N.Value := AName;
      N.ValueType := xvtString;
    end
    else
    if Token = 'CD:' then
    begin
      N.Value := AName;
      N.ValueType := xvtCDATA;
    end;
    Inc(I);
  until I > C;
end;

procedure TJvXMLTree.LoadFromFile(const FileName: string);
begin
  ClearNodes;
  ClearAttributes;
  Lines.LoadFromFile(FileName);
  PreProcessXML(Lines);
  ParseXML;
end;

//=== { TJvXMLFilter } =======================================================

constructor TJvXMLFilter.Create(const FilterStr: string);
begin
  inherited Create;
  Filters := TList.Create;
  Initialize(FilterStr);
end;

destructor TJvXMLFilter.Destroy;
var
  I: Integer;
begin
  for I := 0 to Filters.Count - 1 do
    TJvXMLFilterAtom(Filters[I]).Free;
  Filters.Free;
  inherited Destroy;
end;

procedure TJvXMLFilter.Initialize(FilterStr: string);
var
  LFilter: string;
  P1, P2: Integer;
  AttName, AttValue: string;
  AttOperator: TJvXMLFilterOperator;
  Atom: TJvXMLFilterAtom;
  //    A: TJvXMLAttribute;
  //    N: TJvXMLNode;

  function TrimQuotes(const S: string): string;
  var
    L: Integer;
  begin
    Result := Trim(S);
    if S = '' then
      Exit;
    if (S[1] = '"') or (S[1] = '''') then
      Delete(Result, 1, 1);
    if S = '' then
      Exit;
    L := Length(Result);
    if (Result[L] = '"') or (Result[L] = '''') then
      Delete(Result, L, 1);
  end;

  function SplitNameValue(const S: string): Boolean;
  var
    PP: Integer;
  begin
    // (rom) inefficient implementation
    //      Result:=False;
    PP := PosStr(' $ne$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoNE;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 6, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $ine$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoINE;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 7, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $ge$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoGE;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 6, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $ige$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoIGE;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 7, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $gt$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoGT;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 6, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $igt$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoIGT;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 7, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $le$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoLE;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 6, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $ile$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoILE;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 7, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $lt$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoLT;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 6, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $ilt$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoILT;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 7, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $eq$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoEQ;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 6, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' $ieq$ ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoIEQ;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 7, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    PP := PosStr(' = ', S, 1);
    if PP > 0 then
    begin
      AttOperator := xfoEQ;
      AttName := Trim(Copy(S, 1, PP - 1));
      AttValue := TrimQuotes(Copy(S, PP + 3, Length(S)));
      Result := (AttName <> '') and (AttValue <> '');
      Exit;
    end;
    AttOperator := xfoNOP;
    AttName := S;
    AttValue := '';
    Result := True;
    Exit;
  end;

begin
  P1 := PosStr('[', FilterStr, 1);
  if P1 = 0 then
  begin // just a Name filter on Name
    Name := FilterStr;
    Exit;
  end
  else
  begin
    Name := Copy(FilterStr, 1, P1 - 1);
    Delete(FilterStr, 1, P1 - 1);
  end;
  repeat
    FilterStr := Trim(FilterStr);
    P1 := PosStr('[', FilterStr, 1);
    if P1 = 0 then
      Exit;
    P2 := PosStr(']', FilterStr, P1 + 1);
    if P2 = 0 then
      Exit;
    LFilter := Copy(FilterStr, P1 + 1, P2 - P1 - 1);
    Delete(FilterStr, 1, P2);
    if LFilter = '' then
      Exit;
    // check for attribute filter
    if LFilter[1] = '@' then
    begin
      if not SplitNameValue(Copy(LFilter, 2, Length(LFilter))) then
        Exit;
      Atom := TJvXMLFilterAtom.Create;
      Atom.Name := AttName;
      Atom.Operator := AttOperator;
      Atom.Value := AttValue;
      Atom.AttributeFilter := True;
      Filters.Add(Atom);
    end
    else
    begin // childfilter
      if not SplitNameValue(LFilter) then
        Exit;
      Atom := TJvXMLFilterAtom.Create;
      Atom.Name := AttName;
      Atom.Operator := AttOperator;
      Atom.Value := AttValue;
      Atom.AttributeFilter := False;
      Filters.Add(Atom);
    end;
  until FilterStr = '';
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQXmlTree.pas,v $';
    Revision: '$Revision: 1.17 $';
    Date: '$Date: 2004/09/07 23:11:37 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.