delphi中怎么嵌入 XML

幸福的小雨 2007-03-23 05:07:00
delphi中怎么嵌入 XML
不管是生成还是发送都行,
...全文
368 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
songfuqiang 2007-03-24
  • 打赏
  • 举报
回复
关注ing.......
xiaocai800322 2007-03-23
  • 打赏
  • 举报
回复
关注
wudi_1982 2007-03-23
  • 打赏
  • 举报
回复

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.


wudi_1982 2007-03-23
  • 打赏
  • 举报
回复


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;
wudi_1982 2007-03-23
  • 打赏
  • 举报
回复
好久以前写的东西,你看一下,希望有帮助

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;
ztj007 2007-03-23
  • 打赏
  • 举报
回复
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;

直接在我的代码里拷出来的,希望有参考价值勤
shycoffee 2007-03-23
  • 打赏
  • 举报
回复
从一个URL下载一个XML文件
幸福的小雨 2007-03-23
  • 打赏
  • 举报
回复
哥哥写的都是什么意思呀
hongqi162 2007-03-23
  • 打赏
  • 举报
回复
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;
幸福的小雨 2007-03-23
  • 打赏
  • 举报
回复
我想把应用程序和asp.net程序联系起来,做一个播放器
luxuewei5214 2007-03-23
  • 打赏
  • 举报
回复
internet里有xmlDocument组件,DataAccess里还有一些xml相关的组件
hongqi162 2007-03-23
  • 打赏
  • 举报
回复
发送什么意思?xmlhttp?

16,748

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 语言基础/算法/系统设计
社区管理员
  • 语言基础/算法/系统设计社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧