Delphi XML文件传输DEMO

来源：互联网发布：php 对象赋值编辑：程序博客网时间：2024/05/29 18:34

XML文件传输DEMO

2008-07-21 14:30:52| 分类：软件开发 | 标签：|字号大中小订阅

下面是我在学习XML操作的时候的Demo程序，主要是学习TXMLDocument的使用
      {--------------------------------------------------------------------}
      {                                                                                                                                         }
      {     主题：XML文件传输DEMO                                                                                           }
      {     目的：学习在Delphi中如何使用XML                                                                       }
      {     方法：一、应用控件；二、采用动态创建模式                                                     }
      {                                                                                                                                         }
      {--------------------------------------------------------------------}

{*********************************************************************}
{                                                                                                                                           )
(                                                                                                                                           )
(                                                                                                                                           )
{*********************************************************************}
unit   XMLDemo;

interface

uses
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,
      Dialogs,   xmldom,   XMLIntf,   StdCtrls,   msxmldom,   XMLDoc,   ComCtrls,   Menus,
      XPMenu;

type
      TForm1   =   class(TForm)
          InXMLDOC:   TXMLDocument;
          OutXMLDOC:   TXMLDocument;
          btnWriteXML:   TButton;
          MemoXMLContent:   TMemo;
          btnReadXML:   TButton;
          StatusBar1:   TStatusBar;
          btnExit:   TButton;
          btnSaveMemoToFlie:   TButton;
          TvXML:   TTreeView;
          MainMenu1:   TMainMenu;
          Button1:   TButton;
          Button2:   TButton;
          XPMenu1:   TXPMenu;
          N1:   TMenuItem;
          N2:   TMenuItem;
          procedure   btnWriteXMLClick(Sender:   TObject);
          procedure   FormClose(Sender:   TObject;   var   Action:   TCloseAction);
          procedure   FormCreate(Sender:   TObject);
          procedure   btnReadXMLClick(Sender:   TObject);
          procedure   btnExitClick(Sender:   TObject);
          procedure   btnSaveMemoToFlieClick(Sender:   TObject);
          procedure   Button1Click(Sender:   TObject);
      private
          {   Private   declarations   }
      public
          {   Public   declarations   }
      end;


{-----------------------------------------------------------}
{                                                                                                                       }
{       XML   objects   Test                                                                                 }
{       This   Class   (TStudent)   Apply   to   a   XML   Files                             }
{       named   input.XML                                                                                   }
{-----------------------------------------------------------}
type
      TStudent   =   class   {学生}
          sSex:   string;         //学生性别
          sName:   string;       //学生姓名
          iAge:   Integer;       //学生年龄
          sPhone:   string;     //电话号码

end;

type
      TMenuXML   =   Class
          sMenuName:   String;
          sTips:   string;
          sComName:   string;
          bUsed:   Boolean;
          iLevel:   Integer;
end;


{Input.XML
      <?xml   version="1.0"   encoding="GB2312"   ?>
-   <学生花名册>
-   <学生   性别="男">
      <姓名>李华</姓名>
      <年龄>14</年龄>
      <电话>6287555</电话>
      </学生>
-   <学生   性别="男">
      <姓名>张三</姓名>
      <年龄>16</年龄>
      <电话>8273425</电话>
      </学生>
      </学生花名册>
}


var
      Form1:   TForm1;
      Root:   IXMLNode;   //指向XML根结点
      Parent_Node:   IXMLNode;   //指向学生结点
      Child_node:   IXMLNode;   //指向学生的子结点
      Student:   TStudent;   //存单个学生信息
      List:   TList;   //存学生列
      procedure   XMLDocToTreeView(XMLNode:   IXMLNode;   RootNode:TTreeNode;
          Tv:   TTreeView);

implementation

{$R   *.dfm}
procedure   XMLDocToTreeView(XMLNode:   IXMLNode;   RootNode:   TTreeNode;
      Tv:   TTreeView);
var
      i:   integer;
      node:   TTreeNode;
      Nodetext:   string;
      Attrnode:   IXMLNode;

begin
      if   not   (XMLNode.NodeType   =   ntElement)   then   Exit;
      node   :=   tv.Items.AddChild(RootNode,   XMLNode.NodeValue);
      for   i   :=   0   to   XMLNode.ChildNodes.Count   -   1   do
          XMLDocToTreeView(XMLNode.ChildNodes[i],   node,   tv);
end;

procedure   TForm1.btnWriteXMLClick(Sender:   TObject);
var
      I:   integer;   //循环变量
begin
      //清空List   实例
      for   I   :=   List.Count   -   1   downto   0   do
      begin
          TStudent(List.Items[I]).Free;
          List.Delete(I);
      end;
      List.Pack;

      InXMLDOC.LoadFromFile('Input.XML');   //调入Input.xml文件
      Root   :=   InXMLDoc.DocumentElement;   //取XML文件的根结点，即"<学生花名册>"
      Parent_Node   :=   Root.ChildNodes.First;   //使Parent_Node指向学生结点
      while   (Parent_Node   <>   nil)   do   //循环取多个学生，可再多加几个学生信息测试
      begin
          if   (Parent_Node.NodeName   =   '学生')   then   //判断是否为学生结点
          begin
              Student   :=   TStudent.Create;   //新建一个学生的结构信息
              Student.sSex   :=   Parent_Node.Attributes['性别'];   //取学生的性别属性
              Child_Node   :=   Parent_Node.ChildNodes.First;//使Child_Node指向该学生的第一个子结点信息
              while   (Child_Node   <>   nil)   do   //循环取学生的各个子各点
              begin
                  if   (Child_Node.NodeName   =   '姓名')   then   //判断是否为姓名结点
                      Student.sName   :=   Child_node.Text
                  else   if   (Child_node.NodeName   =   '年龄')   then
                      Student.iAge   :=   StrToInt(Child_node.Text)
                  else   if   (Child_node.NodeName   =   '电话')   then
                      Student.sPhone   :=   Child_node.Text;
                  Child_Node   :=   Child_Node.NextSibling;   //顺序取下一个学生的子结点信息
              end;
              List.Add(Student);
          end;
          Parent_Node   :=   Parent_Node.NextSibling;   //顺序取下一个学生信息
      end;
      /////////////////////////////////////////////////////////////////////////////

      //把导入的XML文件存储到输出的XML文件中
      OutXMLDOC.XML.Clear;
      OutXMLDoc.Active   :=   true;   //激活OutXMLDoc,自动初始化空的XML文档
      OutXMLDoc.Encoding   :=   'GB2312';   //设置字符集
      Root   :=   OutXMLDoc.AddChild('学生花名册');   //建根结点
      for   I   :=   0   to   List.Count   -   1   do   //循环取各个学生信息
      begin
          Student   :=   TStudent(List.Items[I]);   //顺序取一个学生信息
          if   (Student   <>   nil)   then
          begin
              Parent_Node   :=   Root.AddChild('学生');   //根结点后添加一个学生结点
              Parent_Node.Attributes['性别']   :=   Student.sSex;   //给学生结点设置性别属性
              Child_Node   :=   Parent_Node.AddChild('姓名');   //学生结点后添加一个姓名结点
              Child_Node.Text   :=   Student.sName;   //设置姓名的文本值
              Child_Node   :=   Parent_Node.AddChild('年龄');   //此行起后四行与前两行类似
              Child_Node.Text   :=   IntToStr(Student.iAge);
              Child_Node   :=   Parent_Node.AddChild('电话');
              Child_Node.Text   :=   Student.sPhone;
          end;
      end;
      OutXMLDoc.SaveToFile('output.xml');   //把组织好的XML文档存于Output.xml文件中
      OutXMLDoc.Active   :=   False;   //钝化(关闭)OutXMLDoc
end;

procedure   TForm1.FormClose(Sender:   TObject;   var   Action:   TCloseAction);
var
      I:   Integer;
begin
      //释放对象实例List
      for   I   :=   List.Count   -   1   downto   0   do
      begin
          TStudent(List.Items[I]).Free;
          List.Delete(I);
      end;
      List.Pack;
      List.Free;
      Action   :=   caFree;
end;

procedure   TForm1.FormCreate(Sender:   TObject);
begin
      //生成List对象实例
      List   :=   TList.Create;
      //清空Memo
      MemoXMLContent.Clear;
end;

procedure   TForm1.btnReadXMLClick(Sender:   TObject);
begin
      MemoXMLContent.Clear;
      InXMLDOC.LoadFromFile('input.XML');   //调入Input.xml文件
      //InXMLDOC.LoadFromFile('f:\out.xml');
      //MemoXMLContent.Lines.AddStrings(InXMLDOC.XML);
      MemoXMLContent.Lines   :=   InXMLDOC.XML;
end;

procedure   TForm1.btnExitClick(Sender:   TObject);
begin
      Close;
end;

procedure   TForm1.btnSaveMemoToFlieClick(Sender:   TObject);
begin
      OutXMLDoc.XML.Clear;
      OutXMLDoc.XML.AddStrings(MemoXMLContent.Lines);
      OutXMLDOC.Active   :=   True;
      OutXMLDoc.Encoding   :=   'GB2312';   //设置字符集
      OutXMLDOC.SaveToFile('f:\out.xml');
      OutXMLDOC.Active   :=   False;
end;

procedure   DataSetToDOM(RootName,   RecordName:   string;
      XMLDoc:   TXMLDocument;   DataSet:   TDataSet);
var
      iNode   ,iChild:   iXMLNode;
      i   :   integer;
begin
      DataSet.Open;
      DataSet.First;
      {root}
      XMLDoc.DocumentElement   :=   XMLDoc.CreateNode(RootName);
      {add   table   data}
      while   not   DataSet.Eof     do
      begin
          {add   a   node   for   each   record}
          iNode   :=   XMLDoc.DocumentElement.AddChild(RecordName);
          for   I   :=   0   to   DataSet.FieldCount     -   1   do         //   Iterate
          begin
              {add   an   element   for   each   field}
              iChild   :=   iNode.AddChild(DataSet.Fields[i].FieldName);
              if   DataSet.Fields[i].IsNull   then
                  iChild.Text   :=   ''
              else
                  iChild.Text   :=   DataSet.Fields[i].AsString;
          end;         //   for
          DataSet.Next;
      end;         //   while
end;
procedure   TForm1.Button1Click(Sender:   TObject);
begin
      InXMLDOC.LoadFromFile('Menu.XML');   //调入Input.xml文件
      Root   :=   InXMLDoc.DocumentElement;   //取XML文件的根结点
      XMLDocToTreeView(Root,   nil,   TvXML);

end;

end.