本实例应用了MS的MSXML2_TLB，请自行查找下载 //用于读写XML的最简单的单元 unit XMLPurserUnit;
interface uses SysUtils, Classes, Windows, ActiveX, MSXML2_TLB;
type //本例子通过DOM方式演示XML文件的读写过程 TDOMXMLpurser=class public { 创建并保存XML文档，XMLDoc:=CoDOMDocument.Create没有办法将文档类型对象填加 到XMLDoc中，因为它没有引用相应的DTD} procedure SavePropertiesToXML(Filename: string;
Props: TStrings);
{ 解析已有的XML文档 } //适用于节点名称不同的情况 procedure LoadPropertiesFromXML(Filename: string;
Props: TStrings);
//适用于节点相同的情况 procedure LoadFromXML(Filename: string;
Props: TStrings);
end;
implementation const XMLTag = 'xml';
XMLPrologAttrs = 'version="1.0" encoding="UTF-8"';
XMLComment = ' Sample XMLdo
cument with data about movies'#13 + 'and when and where they are showing'#13 + 'Developed by Keith Wood, 28 May 1999 ';
MovieWatcherTag = 'movie-watcher';
MoviesTag = 'movies';
MovieTag = 'movie';
Id = 'id';
Rating = 'rating';
StarringTag = 'starring';
TitleTag = 'title';
//保存XML procedure TDOMXMLpurser.SavePropertiesToXML(Filename: string;
Props: TStrings);
var XMLDoc: IXMLDOMDocument;
i:integer;
//---------------------------------------------------------------------------- procedure AddSimpleElement(Parent: IXMLDOMElement;
Field: string;
AsCDATA: Boolean = False);
var Internal: IXMLDOMElement;
begin
Internal := IXMLDOMElement(Parent.AppendChild( XMLDoc.CreateElement(('Field.FieldName'))));
if AsCDATA then
Internal.AppendChild(XMLDoc.CreateCDATASection(Field)) else
Internal.AppendChild(XMLDoc.CreateTextNode(Field));
end;
procedure GenerateHeaders;
var Title: IXMLDOMElement;
begin
XMLDoc.AppendChild(XMLDoc.CreateProcessingInstruction(XMLTag, XMLPrologAttrs));
XMLDoc.AppendChild(XMLDoc.CreateComment(XMLComment));
XMLDoc.AppendChild(XMLDoc.CreateElement(MovieWatcherTag));
Title := IXMLDOMElement(XMLDoc.DocumentElement.AppendChild( XMLDoc.CreateElement(TitleTag)));
Title.AppendChild(XMLDoc.CreateTextNode('焦点新闻'));
end;
procedure GenerateStars(Starring: IXMLDOMElement);
begin
AddSimpleElement(Starring, '(StarField)');
end;
procedure GenerateMovies(moviename:string);
var Movies, Movie: IXMLDOMElement;
begin
Movies := IXMLDOMElement(XMLDoc.DocumentElement.AppendChild( XMLDoc.CreateElement(MoviesTag)));
Movie := IXMLDOMElement(Movies.AppendChild( XMLDoc.CreateElement(MovieTag)));
Movie.SetAttribute(Id, '123');
Movie.SetAttribute(Rating, '456');
AddSimpleElement(Movie, '789');
AddSimpleElement(Movie, moviename);
AddSimpleElement(Movie, '"(DirectorField)"');
GenerateStars(IXMLDOMElement(Movie.AppendChild( XMLDoc.CreateElement(StarringTag))));
AddSimpleElement(Movie, 'FieldByName(SynopsisField)', True);
end;
//---------------------------------------------------------------------------- begin
try XMLDoc := CoDOMDocument.Create;
GenerateHeaders;
i:=0;
repeat GenerateMovies(Props.Strings);
inc(i);
until i>=Props.Count;
Props.Text := XMLDoc.XML;
XMLDoc.save(Filename);
//u8-dos格式 //Props.SaveToFile(Filename);
//dos格式 finally { Release thedo
M } XMLDoc := nil;
end;
end;
//加载无重复属性的XML procedure TDOMXMLpurser.LoadPropertiesFromXML(Filename: string;
Props: TStrings);
var XMLDoc: IXMLDOMDocument;
i: Integer;
procedure LoadSubProperties(Element: IXMLDOMNode;
PropPrefix: string);
var Index: Integer;
begin
if (Element.NodeType = NODE_TEXT) or (Element.NodeType = NODE_CDATA_SECTION) then
Props.Values[Copy(PropPrefix, 2, Length(PropPrefix) - 1)] := Element.NodeValue else
for Index := 0 to Element.ChildNodes.Length - 1do
LoadSubProperties(Element.ChildNodes[Index], PropPrefix + '.' + Element.NodeName);
end;
begin
XMLDoc := CoDOMDocument.Create;
Props.Clear;
try if XMLDoc.Load(Filename) then
with XMLDoc.DocumentElementdo
for i := 0 to ChildNodes.Length - 1do
LoadSubProperties(ChildNodes, '');
finally XMLDoc := nil;
end;
end;
//加载XML procedure TDOMXMLpurser.LoadFromXML(Filename: string;
Props: TStrings);
var XMLDoc: IXMLDOMDocument;
i: Integer;
procedure LoadSubProperties(Element: IXMLDOMNode;
PropPrefix: string);
var Index: Integer;
begin
if (Element.NodeType = NODE_TEXT) or (Element.NodeType = NODE_CDATA_SECTION) then
Props.Add(Copy(PropPrefix, 2, Length(PropPrefix) - 1)+'='+ Element.NodeValue) else
for Index := 0 to Element.ChildNodes.Length - 1do
LoadSubProperties(Element.ChildNodes[Index], PropPrefix + '.' + Element.NodeName);
end;
begin
XMLDoc := CoDOMDocument.Create;
Props.Clear;
try if XMLDoc.Load(Filename) then
with XMLDoc.DocumentElementdo
for i := 0 to ChildNodes.Length - 1do
LoadSubProperties(ChildNodes, '');
finally XMLDoc := nil;
end;
end;
initialization { Initialise COM } CoInitialize(nil);
finalization { Tidy up } CoUninitialize();
end.
//调用XML读写 unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw,XMLPurserUnit;
type TForm1 = class(TForm) WebBrowser1: TWebBrowser;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private { Private declarations } FXMLpurser:TDOMXMLpurser;
public { Public declarations } end;
var Form1: TForm1;
implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject);
begin
FXMLpurser:=TDOMXMLpurser.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FXMLpurser.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var filename:string;
begin
memo1.Lines.Clear;
filename:=ExtractFilePath(application.ExeName)+'MailTemplate.xml';
FXMLpurser.LoadPropertiesFromXML(filename,memo1.Lines);
end;
procedure TForm1.Button2Click(Sender: TObject);
var filename:string;
begin
memo1.Lines.Clear;
filename:=ExtractFilePath(application.ExeName)+'MailTemplate.xml';
FXMLpurser.LoadFromXML(filename,memo1.Lines);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
FXMLpurser.SavePropertiesToXML(ExtractFilePath(application.ExeName)+'MailTemplate1.xml',memo1.Lines);
end;
end.
//unit1对应的form object Form1: TForm1 Left = 192 Top = 107 Width = 696 Height = 480 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object WebBrowser1: TWebBrowser Left = 8 Top = 8 Width = 321 Height = 361 TabOrder = 0 ControlData = { 4C0000002D2100004F2500000000000000000000000000000000000000000000 000000004C000000000000000000000001000000E0D057007335CF11AE690800 2B2E126208000000000000004C0000000114020000000000C000000000000046 8000000000000000000000000000000000000000000000000000000000000000 00000000000000000100000000000000000000000000000000000000} end object Memo1: TMemo Left = 336 Top = 8 Width = 345 Height = 361 Lines.Strings = ( '星球大战1' '星球大战2' '星球大战3' '星球大战前传1' '星球大战前传2' '星球大战前传3') ScrollBars = ssBoth TabOrder = 1 end object Button1: TButton Left = 192 Top = 384 Width = 147 Height = 25 Caption = 'LoadPropertiesFromXML' TabOrder = 2 OnClick = Button1Click end object Button2: TButton Left = 344 Top = 384 Width = 83 Height = 25 Caption = 'LoadFromXML' TabOrder = 3 OnClick = Button2Click end object Button3: TButton Left = 432 Top = 384 Width = 121 Height = 25 Caption = 'SavePropertiesToXML' TabOrder = 4 OnClick = Button3Click end end //一个最简单的XML文件 MailTemplate.xml <?xml version="1.0"?> <mailTemplate> <smtp> <host>mail.ncisystems.com</host> <port/> <user>keith</user> <from>kbwood@thingies.com</from> </smtp> <database> <alias>mailtemp</alias> <user/> <password/> </database> <settings> <pauseTime>2000</pauseTime> <template>MailMessage.xml</template> <testing>Y</testing> </settings> </mailTemplate> 更多的关于delphi操作xml的详细资料可以看看我的笔记http://cactusprogram.appspot.com/category/xml
