delphi中怎么嵌入 XML
delphi中怎么嵌入 XML
不管是生成还是发送都行，
[解决办法]
uses
comobj;
var
responseText: WideString;
xmlHttp: OLEVariant;
begin
try
xmlHttp:=CreateOleObject( 'Msxml2.XMLHTTP ');
xmlHttp.open( 'GET ',url,false);
xmlHttp.send();
responseText:=xmlHttp.responseText;
if xmlHttp.status= '200 ' then
begin
//
end;
xmlHttp := Unassigned;
except
//
end;
end;
[解决办法]
procedure TFaxPhoneF.ReadFaxXML;
var
FaxXML :TXMLDocument;
FaxNote :ixmlnode;
i,j :integer;
FaxTemp :string;
begin
FaxXML :=TXMLDocument.Create(self);
if FileExists( 'FaxConfig.xml ') then
begin
FaxXML.FileName := 'FaxConfig.xml ';
end;
try
if FaxXML.Active=false then
FaxXML.Active :=true;
FaxNote :=FaxXML.DocumentElement.ChildNodes.Nodes[ 'Fax '];
j :=FaxNote.ChildNodes.Count;
for i :=0 to j-1 do
begin
FaxTemp :=FaxNote.ChildNodes.Nodes[i].ChildNodes.Nodes[ 'Name '].Text
+ ': '+FaxNote.ChildNodes.Nodes[i].ChildNodes.Nodes[ 'Phone '].Text;
Combobox1.Items.Add(FaxTemp);
end;
except
FaxXML.Active :=false;
end;
FaxXML.Active :=false;
end;
直接在我的代码里拷出来的,希望有参考价值勤
[解决办法]
好久以前写的东西,你看一下,希望有帮助
unit FileXmlOperationUt;
//==============================================================================
// 一个用来对文件夹建立目录的XML操作类
// 作者：吴磾
// 制作日期:2003年9月14日
//==============================================================================
interface
uses
SysUtils,msxml,Classes,Dialogs,PublicUt;//ActiveX
{
const
XMLTag = 'xml ';
XMLPrologAttrs = 'version= "1.0 " encoding= "UTF-8 " ';
XMLComment = '用户文件夹信息 '#13 +
'描述结构为序号，文件名以及对此文件的描述信息 '#13 +
'作者的联系方式:wudi_1982@hotmail.com, 2006.9.1 ';
FileWatcherTag = 'FilesInfo ';
WatchTagAttribute = 'WathDir ';
XMLComment2 = '创建文档时间： ';
FilesTag = 'File ';
Dirtag = 'Dir ';
U_Name = 'Name ';
U_Description = 'Description ';
U_FileCount = 'FileCount ';
U_DirCount = 'DirCount '; }
type
RecFileInfo=Record
F_Name : widestring;
f_Description : widestring;
end;
TFhXmlOperation=class
private
FDirCount : integer;
FFileCount : integer;
FActive :boolean;//是否激活状态
FFilename:string; //文件名
FField :RecFileInfo; //接受返回信息
Fxroot :IXMLDOMElement; //根节点
FCurrentNode:IXMLDOMNode; //当前节点
FWathDirName : string;
FXMLDoc :IXMLDOMDocument;
//填加一个子节点
procedure AddSimpleElement(Parent: IXMLDOMElement; Field,Value: string);
procedure AppendFileInfo(Parent: IXMLDOMElement;muser:RecFileInfo;Dirtag : string);
public
constructor create;
procedure CreateBlank(Filename: string;WathDirName : string); //创建一个空的描述文件夹信息的XML文档
procedure OpenXml(Filename: string); //打开文件
procedure CloseXml;
procedure SaveXml;
procedure GetFileInfoForm(Apath,SourFile: string); //递归搜索指定目录
//添加一个关于文件的描述信息
function AppendDescInfo(DName : string; pType : Boolean;NewFlag : Boolean; muser:RecFileInfo):Boolean; //添加一个对文件的描述信息
//根据名称获得节点信息
// function GetNodeInfo(DName : string;tType : Boolean) : RecFileInfo;
//模糊查询
procedure SelectNodeWithName(parent :IXMLDOMElement; Description : string;AStrings: TStrings);
procedure RemoveFileInfo(uname:string;pType : boolean);
function FindFileInfo(uname:widestring;pType : boolean):RecFileInfo;
procedure ReplaceFileInfo(uname:string;newuser:RecFileInfo;pType:boolean);
{
procedure InsertFileInfo(uid:string;muser:RecFileInfo);
function GetNodeLength(node:widestring):integer;
procedure First; //第一个
procedure Prev; //上一个
procedure Next; //下一个
procedure Last; //最后一个 }
property Field : RecFileInfo read FField;
property Xroot :IXMLDOMElement read Fxroot; //根节点
property DirCount : integer read FDirCount;
property FileCount : integer read FFileCount;
//------------------------------------------------
end;
{ var
FXMLOption:TFhXmlOperation; }
implementation
uses StrUtils;
constructor TFhXmlOperation.create;
begin
inherited;
FDirCount := 0;
FFileCount := 0;
FActive := false;
FFilename := ' ';
FWathDirName := ' ';
end;
//创建一个空XML，如果这个Filename文件已经存在，则覆盖
procedure TFhXmlOperation.CreateBlank(Filename: string;WathDirName : string);
var
aElement: IXMLDOMElement;
begin
FActive:=false;
Fxroot:=nil;
FFilename:= ' ';
try
FXMLDoc := CoDOMDocument.Create;
FXMLDoc.AppendChild(FXMLDoc.CreateProcessingInstruction(XMLTag, XMLPrologAttrs)); //添加描述信息
FXMLDoc.AppendChild(FXMLDoc.CreateComment(XMLComment));
//添加根节点
aElement := IXMLDOMElement( FXMLDoc.AppendChild(FXMLDoc.CreateElement(FileWatcherTag)));
//设置属性为
aElement.setAttribute(FileWatcherTag,WathDirName);
aElement.setAttribute(U_FileCount,0);
aElement.setAttribute(U_DirCount,0);
//创建日期
FXMLDoc.AppendChild(FXMLDoc.CreateComment(XMLComment2+datetimetostr(now)));
FFilename:=Filename;
FWathDirName := WathDirName;
Fxroot:=FXMLDoc.documentElement;
FCurrentNode:=Fxroot.firstChild;
FFileCount := 0 ;
FDirCount := 0;
FActive:=true;
except
FXMLDoc:=nil;
end;
end;
//打开一个存在的Filename XML文档
procedure TFhXmlOperation.OpenXml(Filename: string);
begin
Fxroot:=nil;
if not Assigned(FXMLDoc) then
begin
FXMLDoc := CoDOMDocument.Create;
if FXMLDoc.Load(Filename) then FActive:=true
else FActive:=false;
if FActive then
begin
FFilename:=Filename;
Fxroot:=FXMLDoc.documentElement;
FWathDirName := Fxroot.getAttribute(FileWatcherTag);
FDirCount := Fxroot.getAttribute(U_DirCount);
FFileCount := Fxroot.getAttribute(U_FileCount);
FCurrentNode:=Fxroot.firstChild;
end else FFilename:= ' ';
end else begin
Fxroot:=FXMLDoc.documentElement;
FCurrentNode:=Fxroot.firstChild;
end;
end;
//关闭一个打开的XML文档
procedure TFhXmlOperation.CloseXml;
begin
if Assigned(FXMLDoc) then FXMLDoc:=nil;
FFilename:= ' ';
FActive:=false;
end;
procedure TFhXmlOperation.AddSimpleElement(Parent: IXMLDOMElement; Field,Value: string);
var
Internal: IXMLDOMElement;
begin
Internal:=IXMLDOMElement(Parent.AppendChild(FXMLDoc.CreateElement(Field)));
Internal.AppendChild(FXMLDoc.CreateTextNode(Value));
end;
//填加一个节点到后面
procedure TFhXmlOperation.AppendFileInfo(Parent: IXMLDOMElement;muser:RecFileInfo;DirTag : string);
var
xuser:IXMLDOMElement;
xroot:IXMLDOMElement;
begin
if FActive then
begin
xroot:=Parent;
xuser :=IXMLDOMElement(xroot.AppendChild(FXMLDoc.CreateElement(DirTag)));
xuser.setAttribute(U_Name,muser.F_Name);
AddSimpleElement(xuser,U_Description,muser.f_Description);
//FXMLDoc.save(FFilename);
end;
end;
[解决办法]
function TFhXmlOperation.AppendDescInfo(DName: string; pType: Boolean;
NewFlag : Boolean;muser: RecFileInfo):boolean;
var
xfind:IXMLDOMNode;
xroot:IXMLDOMElement;
xpath:string;
i ,count: integer;
tmDname : string;
begin
if not FActive then begin
Result := false;
exit;
end;
xfind := nil;
xroot := FXMLDoc.documentElement;
count := 0;
tmDname := copy(DName,length(FWathDirName)+1,length(DName)-length(FWathDirName));
for I := 1 to length(tmDname) do
begin
if tmDname[i] = '\ ' then
begin
xpath := Dirtag + '[@ '+U_Name + '= " '+copy(tmDname,count+1,i-count-1)+ ' "] ';
xfind := xroot.selectSingleNode(xpath);
if xfind <> nil then xroot := IXMLDOMElement(xfind)
else break;
count := i;
end;
end;
if (length(tmDname)=0) or (xfind <> nil) then
begin
if pType then
AppendFileInfo(xroot,muser,Dirtag)
else AppendFileInfo(xroot,muser,FilesTag);
//FXMLDoc.save(FFilename);
Result := true;
end else Result := false;
end;
{
function TFhXmlOperation.GetNodeInfo(DName: string;tType : Boolean): RecFileInfo;
var
xpath : string;
flag : string;
xroot : IXMLDOMElement;
xfind : IXMLDOMNode;
tm : TStringList;
i : integer;
userinfo : RecFileInfo;
begin
if FActive then
begin
//将dname的最后一位置为\
if copy(DName,length(DName),1) <> '\ ' then
DName := DName + '\ ';
if tType then flag := Dirtag
else flag := FilesTag;
try
tm := TStringList.Create;
tm.Delimiter := '\ ';
//将传入的目录名去掉开头部分
Dname := copy(DName,length(FWathDirName)+1,length(DName)-length(FWathDirName));
tm.DelimitedText := DName;
xroot := FXMLDoc.documentElement;
for I := 0 to tm.Count-2 do
begin
xpath :=flag + '[@ '+U_Name + '= " '+tm[i]+ ' "] ';
xfind := xroot.selectSingleNode(xpath);
if xfind <> nil then xroot := IXMLDOMElement(xfind)
else break;
end;
if xfind <> nil then
begin
userinfo.f_Description := xfind.selectSingleNode(U_Description).text;
userinfo.F_Name := xfind.attributes[0].text;
Result := userinfo;
end;
finally
tm.Free;
end;
end;
end; }
procedure TFhXmlOperation.GetFileInfoForm(Apath,SourFile: string);
var
FSearchRec : TSearchRec;
FindResult : integer;
tm : RecFileInfo;
function IsDirNot(A : string) : boolean;
begin
Result := (a = '. ') or (a = '.. ');
end;
begin
try
FindResult := FindFirst(Apath+Sourfile,faAnyFile,FSearchRec);
while FindResult = 0 do
begin
if ((FSearchRec.Attr and fadirectory) = faDirectory) then
begin
if not IsDirNot(FSearchRec.Name) then begin
//如果是文件夹
inc(FDirCount);//记录数加1
tm.F_Name := FSearchRec.Name;
tm.f_Description := ' ';
AppendDescInfo(APath,true,false,tm);
GetFileInfoForm(APath + FSearchRec.Name + '\ ',Sourfile);
end;
end else begin
inc(FFileCount);
tm.F_Name := FSearchRec.Name;
tm.f_Description := ' ';
AppendDescInfo(APath,false,false,tm);
end;
FindResult := FindNext(FSearchRec);
end;
FXMLDoc.documentElement.setAttribute(U_DirCount,FDirCount);
FXMLDoc.documentElement.setAttribute(U_FileCount,FFileCount);
//FXMLDoc.save(FFilename);
finally
FindClose(FSearchRec);
end;
end;
procedure TFhXmlOperation.SelectNodeWithName(parent :IXMLDOMElement;
Description :string;AStrings: TStrings);
var
ReNodeList : TStringList;
xCur : IXMLDOMNode; //当前节点
troot : IXMLDOMElement;
i : integer;
begin
xCur := parent.firstChild;
ReNodeList := TStringList.Create;
ReNodeList.Clear;
while xCur <> nil do
begin
if xCur.nodeName = Dirtag then
begin
if PosEx(Description,xCur.selectSingleNode(U_Description).text) <> 0 then
ReNodeList.Add(xCur.attributes[0].text);
troot := IXMLDOMElement(xCur);
xCur := xCur.nextSibling;
SelectNodeWithName(troot,Description,AStrings);
end else begin
if (xCur.nodeName = FilesTag) and
(PosEx(Description,xCur.selectSingleNode(U_Description).text) <> 0) then
ReNodeList.Add(xCur.attributes[0].text);
xCur := xCur.nextSibling;
end;
end;
for i := 0 to ReNodeList.Count-1 do
AStrings.Add(ReNodeList.Strings[i]);
ReNodeList.Free;
end;
procedure TFhXmlOperation.SaveXml;
begin
if FActive then
FXMLDoc.save(FFilename);
end;
[解决办法]
procedure TFhXmlOperation.RemoveFileInfo(uname:string;pType : boolean);
var
xfind:IXMLDOMNode;
xroot:IXMLDOMElement;
xpath:string;
begin
if not FActive then exit;
if pType then
xpath:=Dirtag+ '[@ '+U_Name+ '= " '+uname+ ' "] '
else xpath := FilesTag+ '[@ '+U_Name+ '= " '+uname+ ' "] ';
xfind:=FXMLDoc.documentElement.selectSingleNode(xpath);
if xfind <> nil then
begin
xroot:=FXMLDoc.documentElement;
xroot.removeChild(xfind);
end;
end;
function TFhXmlOperation.FindFileInfo(uname: widestring;pType : boolean): RecFileInfo;
var
xuser:IXMLDOMNode;
xpath:string;
begin
result.F_Name:= ' ';
if not FActive then exit;
//关于xpath语法说明，参见www.w3.org/TR/xpath
if pType then xpath:=Dirtag+ '[@ '+U_Name+ '= " '+uname+ ' "] '
else xpath:=FilesTag+ '[@ '+U_Name+ '= " '+uname+ ' "] ';
xuser:=FXMLDoc.documentElement.selectSingleNode(xpath);
if xuser <> nil then
begin
result.F_Name:=xuser.attributes[0].text;
result.f_Description:=xuser.selectSingleNode(U_Description).text;
end;
end;
procedure TFhXmlOperation.ReplaceFileInfo(uname: string;
newuser: RecFileInfo; pType: boolean);
var
xfind,newnode:IXMLDOMNode;
xroot:IXMLDOMElement;
xpath:string;
begin
if not FActive then exit;
if pType then xpath:=Dirtag+ '[@ '+U_Name+ '= " '+uname+ ' "] '
else xpath:=FilesTag+ '[@ '+U_Name+ '= " '+uname+ ' "] ';
xfind:=FXMLDoc.documentElement.selectSingleNode(xpath);
//如果没有找到，则不做替换
if xfind <> nil then
begin
newnode:=xfind.cloneNode(true);
newnode.attributes[0].text := newuser.F_Name;
newnode.selectSingleNode(U_Description).text:=newuser.f_Description;
xroot:=FXMLDoc.documentElement;
xroot.replaceChild(newnode,xfind);
end;
end;
//------------------------------------------
{
function TFhXmlOperation.GetNodeLength(node:widestring):integer;
var
xNode:IXMLDOMNodeList;
xroot:IXMLDOMElement;
xpath:widestring;
begin
result:=0;
xpath:=node;
try
xroot:=FXMLDoc.documentElement;
xNode:=xroot.selectNodes(xpath);
result:=xNode.length;
except
end;
end;
//------------------------------------------
//文档遍历
procedure TFhXmlOperation.First; //第一个
var
xuser:IXMLDOMNode;
begin
FField.F_Id:= ' ';
if FActive then
begin
xuser:=Fxroot.firstChild;
FCurrentNode:=Fxroot.firstChild;
if xuser <> nil then
begin
FField.F_Id:=xuser.selectSingleNode(U_Id).text;
FField.F_Name:=xuser.selectSingleNode(U_Name).text;
FField.F_Paht:=xuser.selectSingleNode(U_Path).text;
FField.f_Description:=xuser.selectSingleNode(U_Description).text;
end;
end;
end;
procedure TFhXmlOperation.Prev; //上一个
var
xuser:IXMLDOMNode;
begin
FField.F_Id:= ' ';
if FActive then
begin
xuser:=FCurrentNode.previousSibling;
if xuser <> nil then
begin
FCurrentNode:=FCurrentNode.previousSibling;
FField.F_Id:=xuser.selectSingleNode(U_Id).text;
FField.F_Name:=xuser.selectSingleNode(U_Name).text;
FField.F_Paht:=xuser.selectSingleNode(U_Path).text;
FField.f_Description:=xuser.selectSingleNode(U_Description).text;
end;
end;
end;
procedure TFhXmlOperation.Next; //下一个
var
xuser:IXMLDOMNode;
begin
FField.F_Id:= ' ';
if FActive then
begin
xuser:=FCurrentNode.nextSibling;
if xuser <> nil then
begin
FCurrentNode:=FCurrentNode.nextSibling;
FField.f_Id:=xuser.selectSingleNode(U_Id).text;
FField.f_Name:=xuser.selectSingleNode(U_Name).text;
FField.F_Paht:=xuser.selectSingleNode(U_Path).text;
FField.f_Description:=xuser.selectSingleNode(U_Description).text;
end;
end;
end;
procedure TFhXmlOperation.Last; //最后一个
var
xuser:IXMLDOMNode;
begin
FField.f_Id:= ' ';
if FActive then
begin
xuser:=Fxroot.lastChild;
FCurrentNode:=Fxroot.lastChild;
if xuser <> nil then
begin
FField.f_Id:=xuser.selectSingleNode(U_Id).text;
FField.f_Name:=xuser.selectSingleNode(U_Name).text;
FField.F_Paht:=xuser.selectSingleNode(U_path).text;
FField.f_Description:=xuser.selectSingleNode(U_Description).text;
end;
end;
end; }
//------------------------------------------
{
initialization
// Initialise COM
// CoInitialize(nil);
FXMLOption := TFhXmlOperation.create;
finalization
// Tidy up
// CoUninitialize();
FXMLOption.Free; }
end.
