操作xml的基类

unit WinstarXML;

interface

uses Windows, Variants, SysUtils, Classes, XMLIntf, XMLDoc, ComCtrls, Dialogs,
  Types,Forms;

type
  TXMLControl = class
  private
    XMLParents: array of IXMLNodeList; //XML目录树;
    LevelCount: integer; //层数
    function IncXMLNodeLevel(NName: string): IXMLNodeList; overload; //增加Level
    function IncXMLNodeLevel(NName, AName, AValue: string): IXMLNodeList;
      overload; //增加Level
    function DecXMLNodeLevel: IXMLNodeList; //减少Level
    procedure CreateXMLNodeTree; //设置目录树的长度

  public
    FileName: string; //XML文件路径;
    FileTime: Int64;
    XD: IXMLDocument; //XML读取控件;
    CurrParents: IXMLNodeList; //当前的XML目录树
    constructor Create;
    procedure txFree;
    function txInitXML(FilePath: string): boolean;
    function txInitXMLFromString(XML: string): boolean;
    procedure txReInitXML;
    //打开XML文件,初始化相关变量;
    procedure txSaveToXML; overload;
    procedure txSaveToXML(NewFN: string); overload;
    //写回文件
    procedure txCloseXML;
    //关闭当前的XML文件;
    function txDownToNode(NName, AName, AValue: string): boolean; overload;
    //定位到当前节点的带属性的子节点
    function txDownToNode(NName: string): boolean; overload;
    function txDownToNode(NodeIndex: Integer): boolean; overload;
    //定位到当前节点的子节点;
    function txUpToNode: boolean;
    //取得节点属性值
    function txGetAttribute(NName, AName: string): string; overload;
    //取得节点属性值
    function txGetAttribute(Index: integer; NName, AName: string): string;
      overload;
    //
    function txGetNode(NName: string): string; overload;
    //取得节点值
    function txGetNode(Index: Integer; NName: string): string; overload;
    //
    function txGetNode(NName, AName, AValue: string): string; overload;
    //
    procedure txGetAllNode(var Strs: TStringList);
    //取得所有子节点的值,返回格式为Name=Value       /
  //procedure txGetAllNode()
    procedure txGetAllAttribute(NName, AName: string; var Strs: TStringList);
    //取得所有子节点的指定属性的值,返回格式为Value
    function txGetNodeCount(NName: string): Integer; overload;
    //定位节点后,取得该节点中的子节点NodeName的个数
    function txGetNodeCount(NName, AName: string): Integer; overload;
    //
    function txGetNodeCount: Integer; overload;
    //取得所有节点中的子节点个数,不管NodeName

    procedure txSetNode(NodeName, NodeValue: string); overload;
    //设置节点值
    procedure txSetNode(NodeName, NodeValue, AttriName, AttriValue: string);
      overload;

    procedure txSetAttribute(NodeName, AttriName, AttriValue: string); overload;
    //设置带属性的节点
    procedure txSetAttribute(NodeName, AttriName, OldAttriValue, AttriValue:
      string); overload;

    procedure txCreateNode(NodeName: string); overload;
    procedure txCreateNode(NodeName, NodeValue: string); overload;
    //创建子节点
    procedure txCreateAttribute(NodeName, AttriName, AttriValue: string);
    //创建带属性的节点
    procedure txDeleteNode(NodeName, NodeValue: string); overload;
    procedure txDeleteNode(NodeName, AttriName, AttriValue: string); overload;
    procedure txDeleteNode(NodeName: string); overload;
    //删除节点
    procedure txDeleteAttrubute(NodeName, AttriName, AttriValue: string);
    //删除带属性的节点
    function txGetXMLText: string;
    //取得
  end;

implementation

{ TXMLControl }

constructor TXMLControl.Create;
begin
  FileName := '';
  XMLParents := nil;
  XD := TXMLDocument.Create('');
  LevelCount := 0;
  FileTime := -1;
end;

procedure TXMLControl.CreateXMLNodeTree;
begin
  LevelCount := 1;
  SetLength(XMLParents, LevelCount);
end;

function TXMLControl.DecXMLNodeLevel: IXMLNodeList;
begin
  if LevelCount > 1 then
  begin
    Dec(LevelCount);
    SetLength(XMLParents, LevelCount);
  end;
  Result := XMLParents[LevelCount - 1];
end;

procedure TXMLControl.txFree;
begin
  FileName := '';
  XMLParents := nil;
  XD.XML.Free;
end;

function TXMLControl.IncXMLNodeLevel(NName: string): IXMLNodeList;

var
  i: integer;
begin
  for i := 0 to XMLParents[LevelCount - 1].Count - 1 do
    if (UpperCase(XMLParents[LevelCount - 1].Get(i).NodeName) = UpperCase(NName))
      and
      (XMLParents[LevelCount - 1].Get(i).HasChildNodes) then
    begin
      Inc(LevelCount); //增加计数
      SetLength(XMLParents, LevelCount);
      XMLParents[LevelCount - 1] :=
        XMLParents[LevelCount - 2].Nodes[NName].ChildNodes; //跳到子节点的树
      Result := XMLParents[LevelCount - 1];
      Exit;
    end;
end;

function TXMLControl.IncXMLNodeLevel(NName, AName,
  AValue: string): IXMLNodeList;
var
  i: integer;
begin
  for i := 0 to XMLParents[LevelCount - 1].Count - 1 do
    if (UpperCase(XMLParents[LevelCount - 1].Get(i).NodeName) = UpperCase(NName))
      and
      (UpperCase(XMLParents[LevelCount - 1].Get(i).Attributes[AName]) =
      UpperCase(AValue)) then
    begin
      Inc(LevelCount); //增加计数
      SetLength(XMLParents, LevelCount);
      XMLParents[LevelCount - 1] :=
        XMLParents[LevelCount - 2].Get(i).ChildNodes;
      Result := XMLParents[LevelCount - 1];
      Exit;
    end;
  //跳到子节点的树
end;

procedure TXMLControl.txCloseXML;
begin
  if Assigned(XD) then
    XD.LoadFromFile('');
  XD.XML.Clear;
  FileName := '';
end;

function TXMLControl.txGetAttribute(NName, AName: string): string;
var
  i: integer;
begin
  Result := '';
   for i := 0 to CurrParents.Count - 1 do
    if (CurrParents.Get(i).HasAttribute(AName)) and
      (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NName)) then
    begin
      Result := CurrParents.Get(i).Attributes[AName];
      exit;
    end;
end;

function TXMLControl.txGetAttribute(Index: integer; NName, AName: string):
  string;
var
  i: integer;
begin
  Result := '';
  for i := 0 to CurrParents.Count - 1 do
    if (i = Index) and (UpperCase(CurrParents.Get(i).NodeName) =
      UpperCase(NName)) then
    begin
      Result := CurrParents.Get(i).Attributes[AName];
      exit;
    end;
end;

function TXMLControl.txGetNode(NName: string): string;
var
  i: integer;
begin
  Result := '';
  for i := 0 to CurrParents.Count - 1 do
    if CurrParents.Get(i).IsTextElement then
      if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NName)) and
        (CurrParents.Get(i).NodeValue <> NULL) then
      begin
        Result := CurrParents.Get(i).NodeValue;
        exit;
      end;
end;

function TXMLControl.txGetNode(Index: Integer; NName: string): string;
var
  i: integer;
begin
  Result := '';
  for i := 0 to CurrParents.Count - 1 do
    if CurrParents.Get(i).IsTextElement then
      if (i = Index) and (UpperCase(CurrParents.Get(i).NodeName) =
        UpperCase(NName)) and
        (CurrParents.Get(i).NodeValue <> NULL) then
      begin
        Result := CurrParents.Get(i).NodeValue;
        exit;
      end;
end;

function TXMLControl.txGetNodeCount(NName: string): Integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to CurrParents.Count - 1 do
    if UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NName) then
      Inc(Result);
end;

function TXMLControl.txDownToNode(NName, AName, AValue: string): boolean;
begin
  Result := True;
  CurrParents := IncXMLNodeLevel(NName, AName, AValue);
  if CurrParents = nil then
  begin
    CurrParents := XMLParents[LevelCount - 1];
    Result := false;
  end;
end;

function TXMLControl.txDownToNode(NName: string): boolean;
begin
  Result := True;
  CurrParents := IncXMLNodeLevel(NName);
  if CurrParents = nil then
  begin
    CurrParents := XMLParents[LevelCount - 1];
    Result := false;
  end;
end;

function TXMLControl.txInitXML(FilePath: string): boolean;
var
  sr: TSearchRec;
begin
  Result := true;
  try
    if UpperCase(FilePath) <> UpperCase(FileName) then
    begin
      if Assigned(XD) then
        XD.LoadFromFile(FilePath);
      FileName := FilePath;
    end
    else
      if FindFirst(FilePath, faAnyFile, sr) = 0 then
      begin
        if sr.Time <> FileTime then
          if Assigned(XD) then
            XD.LoadFromFile(FilePath);
        FileName := FilePath;
        FileTime := sr.Time;
      end;
    CreateXMLNodeTree;
    XMLParents[LevelCount - 1] := XD.ChildNodes;
    CurrParents := XMLParents[LevelCount - 1];
  except
    Result := False;
  end;
end;

procedure TXMLControl.txSetNode(NodeName, NodeValue: string);
var
  i: integer;
  Exist: boolean;
begin
  Exist := false;
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName)) then
    begin
      CurrParents.Get(i).NodeValue := NodeValue;
      exit;
    end;
  if (not Exist) and (NodeValue <> '') then
  begin
    CurrParents.Nodes[NodeName].NodeValue := NodeValue;
  end;
end;

procedure TXMLControl.txSetAttribute(NodeName, AttriName, AttriValue: string);
var
  i: integer;
  Exist: boolean;
begin
  Exist := False;
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName)) then
    begin
      CurrParents.Get(i).Attributes[AttriName] := AttriValue;
      exit;
    end;
  if (not Exist) and (AttriValue <> '') then
  begin
    CurrParents.Nodes[NodeName].Attributes[AttriName] := AttriValue;
  end;
end;

function TXMLControl.txUpToNode: boolean;
begin
  Result := True;
  CurrParents := DecXMLNodeLevel;
  if CurrParents.Count = 0 then Result := false;
end;

function TXMLControl.txGetNodeCount(NName, AName: string): Integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NName)) and
      (CurrParents.Get(i).Attributes[AName] <> NULL) then
      Inc(Result);
end;

function TXMLControl.txGetNodeCount: Integer;
begin
  Result := CurrParents.Count;
end;

procedure TXMLControl.txGetAllNode(var Strs: TStringList);
var
  i: integer;
begin
  Strs := TStringList.Create;
  for i := 0 to CurrParents.Count - 1 do
  begin
    if CurrParents.Get(i).IsTextElement then
      Strs.Add(CurrParents.Get(i).NodeName + '=' +
        CurrParents.Get(i).NodeValue);
  end
end;

procedure TXMLControl.txSaveToXML;
begin
  if Trim(FileName) <> '' then
    XD.SaveToFile(FileName);
end;

procedure TXMLControl.txCreateAttribute(NodeName, AttriName,
  AttriValue: string);
begin
  CurrParents.Nodes[NodeName].NodeValue := '';
  CurrParents.Nodes[NodeName].Attributes[AttriName] := AttriValue;
end;

procedure TXMLControl.txCreateNode(NodeName, NodeValue: string);
begin
  CurrParents.Nodes[NodeName].NodeValue := NodeValue;
end;

procedure TXMLControl.txDeleteAttrubute(NodeName, AttriName, AttriValue:
  string);
var
  i: integer;
begin
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).Attributes[AttriName]) =
      UpperCase(AttriValue)) and
      (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName)) then
    begin
      CurrParents.Remove(CurrParents.Get(i));
      exit;
    end;
end;

procedure TXMLControl.txDeleteNode(NodeName, NodeValue: string);
var
  i: integer;
begin
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName)) and
      (UpperCase(CurrParents.Get(i).NodeValue) = UpperCase(NodeValue)) then
    begin
      CurrParents.Remove(CurrParents.Get(i));
      exit;
    end;
end;

procedure TXMLControl.txReInitXML;
begin
  txInitXML(FileName);
end;

procedure TXMLControl.txGetAllAttribute(NName, AName: string;
  var Strs: TStringList);
var
  i: integer;
begin
  Strs := TStringList.Create;
  for i := 0 to txGetNodeCount - 1 do
  begin
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NName)) and
      (CurrParents.Get(i).Attributes[AName] <> '') then
      Strs.Add(CurrParents.Get(i).Attributes[AName]);
  end;
end;

function TXMLControl.txGetNode(NName, AName, AValue: string): string;
var
  i: integer;
begin
  Result := '';
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NName)) and
      (UpperCase(CurrParents.Get(i).Attributes[AName]) = UpperCase(AValue)) and
      (CurrParents.Get(i).NodeValue <> NULL) then
    begin
      Result := CurrParents.Get(i).NodeValue;
      exit;
    end;
end;

function TXMLControl.txGetXMLText: string;
var
  i: integer;
begin
  Result := '';
  for i := 0 to CurrParents.Count - 1 do
    Result := Result + CurrParents.Get(i).XML;
end;

procedure TXMLControl.txSaveToXML(NewFN: string);
begin
  if Trim(NewFN) <> '' then
    XD.SaveToFile(NewFN);
end;

procedure TXMLControl.txCreateNode(NodeName: string);
begin
  CurrParents.Nodes[NodeName].NodeValue := '';
end;

procedure TXMLControl.txDeleteNode(NodeName: string);
var
  i: integer;
begin
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName)) then
    begin
      CurrParents.Remove(CurrParents.Get(i));
      exit;
    end;
end;

function TXMLControl.txDownToNode(NodeIndex: Integer): boolean;
var
  NName: string;
begin
  Result := True;
  NName := CurrParents.Nodes[NodeIndex].NodeName;
  CurrParents := IncXMLNodeLevel(NName);
  if CurrParents = nil then
  begin
    CurrParents := XMLParents[LevelCount - 1];
    Result := false;
  end;
end;

procedure TXMLControl.txSetNode(NodeName, NodeValue, AttriName,
  AttriValue: string);
var
  i: integer;
  Exist: boolean;
begin
  Exist := false;
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName))
      and (UpperCase(CurrParents.Get(i).Attributes[AttriName]) =
      UpperCase(AttriValue)) then
    begin
      CurrParents.Get(i).NodeValue := NodeValue;
      exit;
    end;
  if (not Exist) and (NodeValue <> '') then
  begin
    CurrParents.Nodes[NodeName].NodeValue := NodeValue;
  end;
end;

procedure TXMLControl.txSetAttribute(NodeName, AttriName, OldAttriValue,
  AttriValue: string);
var
  i: integer;
  Exist: boolean;
begin
  Exist := False;
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName))
      and (UpperCase(CurrParents.Get(i).Attributes[AttriName]) =
      UpperCase(OldAttriValue)) then
    begin
      CurrParents.Get(i).Attributes[AttriName] := AttriValue;
      exit;
    end;
  if (not Exist) and (AttriValue <> '') then
  begin
    CurrParents.Nodes[NodeName].Attributes[AttriName] := AttriValue;
  end;
end;

procedure TXMLControl.txDeleteNode(NodeName, AttriName,
  AttriValue: string);
var
  i: integer;
begin
  for i := 0 to CurrParents.Count - 1 do
    if (UpperCase(CurrParents.Get(i).NodeName) = UpperCase(NodeName))
      and (UpperCase(CurrParents.Get(i).Attributes[AttriName]) =
      UpperCase(AttriValue)) then
    begin
      CurrParents.Remove(CurrParents.Get(i));
      exit;
    end;
end;

function TXMLControl.txInitXMLFromString(XML: string): boolean;
begin
  Result := True;
  try
    XD.LoadFromXML(XML);
    CreateXMLNodeTree;
    XMLParents[LevelCount - 1] := XD.ChildNodes;
    CurrParents := XMLParents[LevelCount - 1];
  except
    Result := False;
  end;
end;

end.
在公司中写的一个类,对XML的操作简单化.功能强大