这段时间要用 delphi写一个ActiveX ,其中用到XML交互,所以写了一个TXmlHelper类,和大家共享,并希望大家提出修改意见

傻乐tao 2003-10-16 10:38:29
unit XmlHelper;

interface

uses
Windows, Messages, SysUtils, Variants, Classes,Dialogs,Graphics,Controls,Forms,ComCtrls,
StdCtrls,ExtCtrls,xmldom, XMLDoc, XMLIntf,Math,Contnrs;

type

TXmlNodeObject = class(TObject)
public
XmlNode : IXmlNode;
end;

//-----------------------------------------------
// Xml装载方式
//
//-----------------------------------------------
TXmlLoadType = (FromString,FromLocalFile,FromURL);

TXmlHelper = class(TObject)
private
m_XmlDoc: IXmlDocument;
m_sLastErrorMessage: WideString;

function GetDocument:IXmlDocument;
function GetEncoding:WideString;
procedure SetEncoding(const Value: WideString);
function GetRootNode: IXmlNode;

public
Constructor Create;overload;
Constructor Create(xmlDoc:IXmlDocument);overload;
Destructor Free;

property Document:IXmlDocument read GetDocument;
property Encoding:WideString read GetEncoding write SetEncoding;
property RootNode:IXmlNode read GetRootNode;

function SaveToFile(sTargetFileName : WideString):Boolean;
function GetXmlString: WideString;
function LoadXML(sourceXMLOrFile:WideString;loadType:TXmlLoadType):Boolean;


function GetAttributeValue(node : IXmlNode; sAttributeName : WideString):WideString;
function GetAttributeInt32(node : IXmlNode; sAttributeName : WideString):Integer;
function GetAttributeDouble(node : IXmlNode; sAttributeName : WideString):Double;
function GetAttributeBoolean(node : IXmlNode; sAttributeName : WideString):Boolean;

function GetElementValue(node : IXmlNode):WideString;
function GetElementInt32(node : IXmlNode):Integer;
function GetElementDouble(node : IXmlNode):Double;
function GetElementBoolean(node : IXmlNode):Boolean;

function GetChildElementValue(parentNode : IXmlNode;sElementName : WideString):WideString;
function GetChildElementInt32(parentNode : IXmlNode;sElementName : WideString):Integer;
function GetChildElementDouble(parentNode : IXmlNode;sElementName : WideString):Double;
function GetChildElementBoolean(parentNode : IXmlNode;sElementName : WideString):Boolean;


function GetFirstChildXmlNodeFromRoot(sElementName : WideString) : TXmlNodeObject;
function GetFirstChildXmlNode(parentNode : IXmlNode;sElementname : WideString) : IXmlNode;
function GetChildNodesFromRoot( sElementName : WideString ) : TObjectList;
function GetRecursiveChildNodesFromParent(parentNode : IXmlNode;sElementName : WideString) : TObjectList;

function CreateNodeElement(parentNode : IXmlNode ; sElementName,sElementValue : WideString) : IXmlNode;
//function CreateComment(insertAfterThisNode : IXmlNode;sVal : WideString) : IXmlNode;
//function CreateXmlDeclaration(sVersion,sEncoding,sStandalone : WideString) : IXmlNode;
function DeleteNodeElement(targetNode : IXmlNode) : Boolean;
function ModifyNodeElementValue(targetNode : IXmlNode;sNewElementValue : WideString) : Boolean;

function CreateNodeAttribute(targetNode : IXmlNode;sAttrName,sAttrValue : WideString) : Boolean;
function DeleteNodeAttribute(targetNode : IXmlNode;sAttrName : WideString) : Boolean;
function ModifyNodeAttributeValue(targetNode : IXmlNode;sAttrName,sNewAttrValue : WideString) : Boolean;

function Encode(input : string) : string;
function Decode(input : string) : string;

end;



...全文
71 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
upingking 2003-10-23
  • 打赏
  • 举报
回复
好人
djwdjw 2003-10-23
  • 打赏
  • 举报
回复
正中我想要的,楼主,谢了!
lhzongji 2003-10-17
  • 打赏
  • 举报
回复
good,up!!!!
傻乐tao 2003-10-16
  • 打赏
  • 举报
回复
测试form 单元
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,XmlHelper, StdCtrls,xmldom, XMLDoc, XMLIntf,Math;



type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Contnrs;

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
OPenDialog1.Execute;

Edit1.Text := OpenDialog1.Files[0];

end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
xmlhelp : TXmlHelper;
xmldoc : IXmlDocument;
ts:TStrings;
s,ttt : WideString;
nodes : TObjectList;
root : IXmlNode;
tmp : IXmlNode;
test,testbbb : TObjectList;
aaa,bbb : TXmlNodeObject;

begin


xmlhelp := TXmlHelper.Create;

xmlhelp.LoadXML(Edit1.Text,XmlHelper.FromLocalFile);

xmlhelp.Encoding := 'gb2312';

tmp := xmlhelp.CreateNodeElement(xmlhelp.RootNode,'taoshi','3333333');

xmlhelp.CreateNodeAttribute(xmlhelp.RootNode,'Name','stone');
xmlhelp.SaveToFile('c:\test1.xml');

xmlhelp.CreateNodeAttribute(xmlhelp.RootNode,'Name','stone-modify');
xmlhelp.SaveToFile('c:\test2.xml');

xmlhelp.DeleteNodeAttribute(xmlhelp.RootNode,'Name');
xmlhelp.SaveToFile('C:\test3.xml');

ShowMessage(xmlhelp.GetXmlString());

//bbb.XmlNode. := 'ahhahaa';
bbb.Free;
bbb := nil;

// ShowMessage(bbb.XmlNode.Text);

ShowMessage(aaa.XmlNode.Text);



xmldoc := xmlhelp.Document;


root := xmlhelp.RootNode;

nodes := xmlhelp.GetRecursiveChildNodesFromParent(xmlhelp.RootNode,'dd');

for I := 0 to nodes.Count - 1 do // Iterate
begin
tmp := (nodes.Items[I] as TXmlNodeObject).XmlNode;
ShowMessage( tmp.NodeName + ' -> ' + tmp.XML);
end; // for

nodes := xmlhelp.GetRecursiveChildNodesFromParent(xmlhelp.RootNode,'cc');

for I := 0 to nodes.Count - 1 do // Iterate
begin
tmp := (nodes.Items[I] as TXmlNodeObject).XmlNode;
ShowMessage(tmp.NodeName + ' -> ' + tmp.NodeValue);
end; // for



ShowMessage(root.Attributes['alpha']);

ShowMessage(root.Attributes['alphaa']);

//tmp := root.AddChild('comment');
//tmp.NodeValue := 'test comment';

ShowMessage(root.NodeName);

//xmldoc.SaveToFile('c:\ttt.xml');

s:= '';

ShowMessage(xmldoc.Encoding);


ts:= xmldoc.XML;
ttt := ts.Text;
ShowMessage(ttt);
ShowMessage(ts.CommaText);
ShowMessage(ts.GetNamePath);

for i := 0 to xmldoc.XML.Count - 1 do // Iterate
begin

s := s + xmldoc.XML[i];
end; // for

ShowMessage(s);



ShowMessage(xmlhelp.GetXmlString);

xmlhelp.Free;

xmlhelp := nil;
end;

end.
zf1202 2003-10-16
  • 打赏
  • 举报
回复
继续呀,有看头
傻乐tao 2003-10-16
  • 打赏
  • 举报
回复
function TXmlHelper.Encode(input: string): string;
var
output : string;
begin
Result := '';

if input = '' then
Exit;

output := input;

output := StringReplace(output, '&', '&',[rfReplaceAll]);
output := StringReplace(output, '<', '<',[rfReplaceAll]);
output := StringReplace(output, '>', '>',[rfReplaceAll]);
output := StringReplace(output, '"', '"',[rfReplaceAll]);

Result := output;
end;


function TXmlHelper.GetChildNodesFromRoot(
sElementName: WideString): TObjectList;
var
I : Integer;
node : IXmlNode;
nodeslists : TObjectList;
selectNode : TXmlNodeObject;
begin

node := RootNode;
nodeslists := TObjectList.Create;
for I := 0 to node.ChildNodes.Count - 1 do // Iterate
begin
if node.ChildNodes[I].NodeName = sElementName then
begin
selectNode := TXmlNodeObject.Create;
selectNode.XmlNode := node.ChildNodes[I];
nodeslists.Add(selectNode);
end;
end; // for

Result := nodeslists;

end;

function TXmlHelper.GetFirstChildXmlNode(parentNode: IXmlNode;
sElementname: WideString): IXmlNode;
var
I: Integer;
foundNode : IXmlNode;
begin

foundNode := nil;
for I := 0 to parentNode.ChildNodes.Count - 1 do // Iterate
begin
if parentNode.ChildNodes[I].NodeName = sElementName then
begin
foundNode := parentNode.ChildNodes[I];
break;
end
end; // for

Result := foundNode;

end;

function TXmlHelper.GetFirstChildXmlNodeFromRoot(
sElementName: WideString): TXmlNodeObject;
var
nodeslists : TObjectList;
begin

Result := nil;

nodeslists := GetChildNodesFromRoot(sElementName);

if nodeslists.Count > 0 then
Result := nodeslists[0] as TXmlNodeObject;

end;

function TXmlHelper.GetRecursiveChildNodesFromParent(parentNode : IXmlNode;
sElementName: WideString): TObjectList;
var
I,J,K: Integer;
childNodeLists : TObjectList;
tmpChildNodeLists : TObjectList;
selectNode : TXmlNodeObject;
begin

childNodeLists := TObjectList.Create;

for I := 0 to parentNode.ChildNodes.Count - 1 do // Iterate
begin
if parentNode.ChildNodes[I].NodeName = sElementName then
begin
selectNode := TXmlNodeObject.Create;
selectNode.XmlNode := parentNode.ChildNodes[I];
childNodeLists.Add(selectNode);
end;

//Recursive
if parentNode.ChildNodes[I].HasChildNodes then
begin
tmpChildNodeLists := GetRecursiveChildNodesFromParent(parentNode.ChildNodes[I],sElementName);
for J := 0 to tmpChildNodeLists.Count - 1 do // Iterate
childNodeLists.Add(tmpChildNodeLists.Items[J]);

//这里如果不注释掉总会有异常抛出,不知道为什么,所以递归调用时,这里会有内存没有Free!!!
//有内存息漏
{if tmpChildNodeLists <> nil then
begin
tmpChildNodeLists.Clear;
tmpChildNodeLists.Free;
end;
}
end;
end; // for

Result := childNodeLists;

end;

function TXmlHelper.CreateNodeElement(parentNode: IXmlNode; sElementName,
sElementValue: WideString): IXmlNode;
var
childNode : IXmlNode;
begin
childNode := parentNode.AddChild(sElementName);
if sElementValue <> '' then
begin
childNode.NodeValue := Encode(sElementValue);
end;

Result := childNode;
end;

function TXmlHelper.DeleteNodeElement(targetNode: IXmlNode): Boolean;
var
nRet : Integer;
begin
Result := false;
try

nRet := targetNode.ParentNode.ChildNodes.Remove(targetNode);
if(nRet <> -1) then
Result := true;

except
Result := false;
end;
end;

function TXmlHelper.ModifyNodeElementValue(targetNode: IXmlNode;
sNewElementValue: WideString): Boolean;
begin
Result := false;
try

if(targetNode.ReadOnly) then
exit;

targetNode.NodeValue := Encode(sNewElementValue);

Result := true;
except
Result := false;
end;

end;

function TXmlHelper.CreateNodeAttribute(targetNode: IXmlNode; sAttrName,
sAttrValue: WideString): Boolean;
begin
targetNode.SetAttributeNS(sAttrName,targetNode.NamespaceURI,Encode(sAttrValue));
end;

function TXmlHelper.DeleteNodeAttribute(targetNode: IXmlNode;
sAttrName: WideString): Boolean;
var
oAttrXmlNode : IXmlNode;
nRet : Integer;
begin
Result := false;
try
oAttrXmlNode := targetNode.AttributeNodes[sAttrName];
if( (oAttrXmlNode <> nil) and (oAttrXmlNode.NodeType = ntAttribute) ) then
begin
nRet := targetNode.AttributeNodes.Remove(oAttrXmlNode);
if(nRet <> -1) then
Result := true;
end;

except
Result := false;
end;
end;

function TXmlHelper.ModifyNodeAttributeValue(targetNode: IXmlNode;
sAttrName, sNewAttrValue: WideString): Boolean;
begin
targetNode.SetAttributeNS(sAttrName,targetNode.NamespaceURI,Encode(sNewAttrValue));
end;

end.
傻乐tao 2003-10-16
  • 打赏
  • 举报
回复

function TXmlHelper.GetAttributeDouble(node: IXmlNode;
sAttributeName: WideString): Double;
var
sAttrValue : string;
dAttrValue : Double;
begin

Result := 0.00;

sAttrValue := GetAttributeValue(node,sAttributeName);

if( TryStrToFloat(sAttrValue,dAttrValue) ) then
Result := dAttrValue;

end;

function TXmlHelper.GetAttributeInt32(node: IXmlNode;
sAttributeName: WideString): Integer;
var
sAttrValue : string;
nAttrValue : Integer;
begin
Result := 0;

sAttrValue := GetAttributeValue(node,sAttributeName);

if( TryStrToInt(sAttrValue,nAttrValue) ) then
Result := nAttrValue;
end;

function TXmlHelper.GetAttributeValue(node: IXmlNode;
sAttributeName: WideString): WideString;
begin

if ( node.HasAttribute(sAttributeName) ) then
begin
Result := Decode(node.Attributes[sAttributeName]);
end
else
raise EXmlDocError.Create('节点没有指定的属性');
end;


function TXmlHelper.GetChildElementBoolean(parentNode: IXmlNode;
sElementName: WideString): Boolean;
var
sElementValue : string;
bElementValue : Boolean;
begin
Result := false;

sElementValue := GetChildElementValue(parentNode,sElementName);
if( (LowerCase(sElementValue) = 'true') or (LowerCase(sElementValue) ='yes') ) then
Result := true;

end;

function TXmlHelper.GetChildElementDouble(parentNode: IXmlNode;
sElementName: WideString): Double;
var
sElementValue : string;
dElementValue : Double;
begin
Result := 0.00;

sElementValue := GetChildElementValue(parentNode,sElementName);
if TryStrToFloat(sElementValue,dElementValue) then
Result := dElementValue;
end;

function TXmlHelper.GetChildElementInt32(parentNode: IXmlNode;
sElementName: WideString): Integer;
var
sElementValue : string;
nElementValue : Integer;
begin
Result := 0;

sElementValue := GetChildElementValue(parentNode,sElementName);
if TryStrToInt(sElementValue,nElementValue) then
Result := nElementValue;

end;

function TXmlHelper.GetChildElementValue(parentNode: IXmlNode;
sElementName: WideString): WideString;
var
I : Integer;
childNodeList : IXmlNodeList;
childNode : IXmlNode;
bFind : Boolean;
begin
Result := '';

bFind := false;
childNodeList := parentNode.ChildNodes;
for I := 0 to childNodeList.Count - 1 do // Iterate
begin
if(childNodeList[I].NodeName = sElementName) then
begin
childNode := childNodeList[I];
bFind := true;
break;
end
end; // for

if bFind then
Result := GetElementValue(childNode);

end;


function TXmlHelper.GetElementBoolean(node: IXmlNode): Boolean;
var
sValue : string;
begin
Result := false;

sValue := GetElementValue(node);
if( (LowerCase(sValue) = 'true') or (LowerCase(sValue) ='yes') ) then
Result := true;

end;

function TXmlHelper.GetElementDouble(node: IXmlNode): Double;
var
sValue : string;
dValue : Double;
begin
Result := 0.00;

sValue := GetElementValue(node);
if( TryStrToFloat(sValue,dValue)) then
Result := dValue;

end;

function TXmlHelper.GetElementInt32(node: IXmlNode): Integer;
var
sValue : string;
nValue : Integer;
begin
Result := 0;

sValue := GetElementValue(node);
if( TryStrToInt(sValue,nValue)) then
Result := nValue;

end;

function TXmlHelper.GetElementValue(node: IXmlNode): WideString;
begin
Result := Decode(node.NodeValue);
end;

function TXmlHelper.Decode(input: string): string;
var
output : string;
begin
Result := '';

output := input;
output := StringReplace(output, '&','&',[rfReplaceAll]);
output := StringReplace(output, '<', '<',[rfReplaceAll]);
output := StringReplace(output, '>', '>',[rfReplaceAll]);
output := StringReplace(output, '"', '"',[rfReplaceAll]);

Result := output;
end;
傻乐tao 2003-10-16
  • 打赏
  • 举报
回复
实现部分:
implementation

{ TXmlHelper }

constructor TXmlHelper.Create;
begin
Inherited Create;
m_sLastErrorMessage := '';
m_XmlDoc := TXMLDocument.Create(nil);
end;

constructor TXmlHelper.Create(xmlDoc: IXmlDocument);
begin
Inherited Create;
m_sLastErrorMessage := '';
if( xmlDoc = nil) then
begin
m_XmlDoc := TXMLDocument.Create(nil);
end
else begin
m_XmlDoc := xmlDoc;
end;

end;

destructor TXmlHelper.Free;
begin
if(m_XmlDoc <> nil) then
begin
//m_XmlDoc.Free;
m_XmlDoc.Active := False;
m_XmlDoc := nil;
end;
inherited Destroy;
end;

function TXmlHelper.GetDocument: IXmlDocument;
begin
Result := m_XmlDoc;
end;

function TXmlHelper.GetEncoding: WideString;
begin
if( m_XmlDoc = nil) then
raise EInvalidArgument.Create('XmlHelper ÀïµÄDocument Ϊ¿Õ');

Result := m_XmlDoc.Encoding;
end;

procedure TXmlHelper.SetEncoding(const Value: WideString);
begin
if( m_XmlDoc = nil) then
raise EInvalidArgument.Create('XmlHelper ÀïµÄDocument Ϊ¿Õ');

m_XmlDoc.Encoding := Value;
end;


function TXmlHelper.GetXmlString: WideString;
begin
if( m_XmlDoc = nil) then
raise EInvalidArgument.Create('XmlHelper ÀïµÄDocument Ϊ¿Õ');

Result := m_XmlDoc.XML.Text;

end;

function TXmlHelper.LoadXML(sourceXMLOrFile: WideString;
loadType: TXmlLoadType): Boolean;
begin
Result := false;
try
case loadType of
FromString : m_XmlDoc.LoadFromXML(sourceXMLOrFile);
FromLocalFile : m_XmlDoc.LoadFromFile(sourceXMLOrFile);
FromURL : m_XmlDoc.FileName := sourceXMLOrFile;
else
raise EInvalidArgument.Create('XmlHelper 里的document为空');
end;

m_XmlDoc.Active := true;
Result := true;
except
Result := false;
end;

end;

function TXmlHelper.SaveToFile(sTargetFileName: WideString): Boolean;
begin
Result := false;
try
m_XmlDoc.SaveToFile(sTargetFileName);
Result := true;
except
Result := false;
end;
end;


function TXmlHelper.GetRootNode : IXmlNode;
var
nIndex : Integer;
firstnode : IXmlNode;

begin

if(m_XmlDoc = nil) then
raise EInvalidArgument.Create('XmlHelper ÀïµÄDocument Ϊ¿Õ');

nIndex := 0;

firstnode := m_XmlDoc.ChildNodes[nIndex];

while (firstnode.NodeType <> ntElement) do
begin
nIndex := nIndex + 1;
if nIndex >= m_XmlDoc.ChildNodes.Count then
raise EOverflow.Create('XmlHelper 里的document为空);

firstnode := m_XmlDoc.ChildNodes[nIndex];
end;

Result := firstnode;

end;


//节点属性为true or yes 返回真
//否则返回假
function TXmlHelper.GetAttributeBoolean(node: IXmlNode;
sAttributeName: WideString): Boolean;
var
sAttrValue : string;
begin
Result := false;
sAttrValue := GetAttributeValue(node,sAttributeName);
if( (LowerCase(sAttrValue) = 'true') or (LowerCase(sAttrValue) ='yes') ) then
Result := true ;

end;

5,386

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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