XML在DELPHI中的应用

XML在DELPHI中的应用  

2008-06-27 21:45:16|  分类： Delphi访问Xml文 |字号 订阅

unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, Buttons, xmldom, XMLIntf,
xmlxform,
msxmldom, XMLDoc, DBGridEh;

    procedure SaveXmlOption(ADBGrid:TDBGridEh);
end;

var
FrmMain: TFrmMain;

implementation
uses
msxml;
{$R *.dfm}
function GetAppPath:String;
begin
Result:=ExtractFilePath(ParamStr(0));
end;

procedure TFrmMain.SaveXmlOption(ADBGrid: TDBGridEh);
var
   i:integer;
   doc:TXMLDocument;
   RNode,FNode:IXMLNode;
begin
try
     doc:=TXMLDocument.Create(nil);
     doc.Active:=True;
     doc.Version:='1.0';
     doc.Encoding:='utf-8';
     //======
     RNode:=doc.AddChild(ADBGrid.Name);
     for i:=0 to ADBGrid.Columns.Count-1 do
     begin
       FNode:=RNode.AddChild(ADBGrid.Columns[i].FieldName);
       FNode.SetAttribute('Title',ADBGrid.Columns[i].Title.Caption);
       FNode.SetAttribute('Width',IntToStr(ADBGrid.Columns[i].Width));
     end;
     Memo1.Text:=doc.XML.Text;
     doc.SaveToFile(GetAppPath+ADBGrid.Name+'.xml');
finally
    doc:=nil;
end;
end;

procedure TFrmMain.BitBtn1Click(Sender: TObject);
begin
   DBGridEh1.Columns.LoadFromFile(GetAppPath+'dbgrid.cld');
end;

procedure TFrmMain.BitBtn2Click(Sender: TObject);
begin
DBGrid1.Columns.SaveToFile(GetAppPath+DBGrid1.Name+'.rxl');
SaveXmlOption(DBGridEh1);
end;

end.

unit ShowXML;
interface
uses Classes HTTPApp Db DbClient Midas
XMLBrokr WebComp MidItems;
type
TCustomShowXMLButton = class(TXMLButton IScriptComponent)
protected
XMLMethodName: string;
{ IScriptComponent }
procedure AddElements(AddIntf: IAddScriptElements);
function GetSubComponents: TObject;
{ IWebContent implementation }
function ImplContent(Options: TWebContentOptions;
ParentLayout: TLayout): string; override;
end;
TShowXMLButton = class(TCustomShowXMLButton)
public
constructor Create(AOwner: TComponent); override;
published
property Custom;
property Style;
property StyleRule;
property Caption;
property XMLBroker;
property XMLUseParent;
end;
TShowDeltaButton = class(TCustomShowXMLButton)
public
constructor Create(AOwner: TComponent); override;
published
property Custom;
property Style;
property StyleRule;
property Caption;
property XMLBroker;
property XMLUseParent;
end;
implementation
uses sysutils MidProd;
resourcestring
sShowXML = 'Show XML';
sShowDelta = 'Show Delta';
procedure TCustomShowXMLButton.AddElements(
AddIntf: IAddScriptElements);
begin

AddIntf.AddIncludeFile('xmlshow.js');
end;
function TCustomShow XMLButton.GetSubComponents: TObject;
begin
Result := nil;
end;
function TCustomShow XMLButton.ImplContent(Options: TWebContentOptions;
ParentLayout: TLayout): string;
var
Attrs: string;
Intf: ILayoutWebContent;
FormVarName: string;
RowSetVarName: string;
begin
AddQuotedAttrib(Attrs 'NAME' Name);
AddQuotedAttrib(Attrs 'STYLE' Style);
AddQuotedAttrib(Attrs 'CLASS' StyleRule);
AddQuotedAttrib(Attrs 'VALUE' Self.Caption);
AddCustomAttrib(Attrs Custom);
if Assigned( XMLData. XMLBroker) then
begin
FormVarName := XMLData. XMLBroker.SubmitFormVarName;
RowSetVarName := XMLData. XMLBroker.RowSetVarName(nil); // Row row set var name
end;
if not (coNoScript in Options.Flags) then
Result :=
Format(''#13#10
[Attrs RowSetVarName XMLMethodName s XMLReadyVar])
else
Result :=
Format(''#13#10
[Attrs]);
if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent Intf) then
Result := Intf.LayoutButton(Result GetLayoutAttributes);
end;
{ TShow XMLButton }
constructor TShow XMLButton.Create(AOwner: TComponent);
begin
inherited;
DefaultCaption := sShow XML;
XMLMethodName := 'root';

end;
{ TShowDeltaButton }
constructor TShowDeltaButton.Create(AOwner: TComponent);
begin
inherited;
DefaultCaption := sShowDelta;
XMLMethodName := 'getDelta()';
end;
另一种方法使用msxml.dll 如下:
....
....
procedure TDHEDForm.OpenBtnClick(Sender: TObject);
var
pVIn : OleVariant;
Prompt : OleVariant;
begin
pVIn := '';
Prompt := True;
DHtmlEdit1.LoadDocument(pVIn Prompt);
end;
procedure TDHEDForm.SaveBtnClick(Sender: TObject);
var
vo vb : OleVariant;
begin
vo := DHTMLEdit1.CurrentDocumentPath;
if (vo <> '') then
begin
vb := false;
end
else
begin
vo := '';
vb := true;
end;
DHTMLEdit1.SaveDocument(vo vb);
end;
procedure TDHEDForm.SaveAsClick(Sender: TObject);
var
vo vb : OleVariant;
begin
vo := '';
vb := true;
DHTMLEdit1.SaveDocument(vo vb);
end;
..

////////////////////////////////////////////////////////////////////////
创建IXMLDOMDocument对象的三种方法：
(1)[方法1] 直接创建 IXMLDOMDocument , 例(1)
   uses msxml;
   var DOC:IXMLDOMDocument;
   doc := CoDOMDocument.create;
   .....
   Doc := nil;
A)doc.load('C:\temp.xml'); //从文件载入
B) 动态创建
   var aElement,aElement2: IXMLDOMElement; // [ aNode:IXMLDOMNode ==> .AppendChild() ]

   //加入版本信息 ‘<?xml version="1.0" ?> ’
   doc.AppendChild(doc.CreateProcessingInstruction('xml', 'version="1.0" encoding="GB2312"'));
     (*)因为此函数返回结果不包含 'encoding="GB2312"' 故须保存前注意.
   //加入根结点
   doc.AppendChild(doc.CreateElement('bootDocNode')); //// == aElement
   //加入子结点
   aElement:=IXMLDOMElement(Doc.DocumentElement.AppendChild(Doc.CreateElement('ChileNode1')));
   //设置接点属性
   aElement.SetAttribute('ID', '11');
   aElement.SetAttribute('Units', '元/m2');
   //设置结点内容
   aElement.AppendChild(Doc.CreateTextNode('结点内容'));
   //子结点添加子结点
   aElement2:=IXMLDOMElement(aElement.AppendChild(Doc.CreateElement('Child_ChileNode1')));

(2) [方法2] 直接创建 IXMLDocument ( 不是IXMLDOMDocument )
uses XMLIntf,XMLDoc;
var xmlDoc:IXMLDocument; aNode:IXMLNode; s:string;

xmlDoc := TXMLDocument.Create(nil);
try
    //加入版本信息 ‘<?xml version="1.0" encoding="GB2312" ?> ’
    xmlDoc.Active := True;   xmlDoc.Version := '1.0'; xmlDoc.Encoding :='GB2312';
    //加入根结点
    aNode:=xmlDoc.AddChild('bootDocNode');
    //加入子结点
    aNode:=aNode.AddChild('ChileNode1');
    //设置接点属性
    aNode.SetAttribute('ID', '22');
    aNode.SetAttribute('Units', '元/m2');
    //设置结点内容
    aNode.Text := '结点内容';
    //子结点添加子结点
    aNode:=aNode.AddChild('Child_ChileNode1') ;
    aNode.Text := 'Child_ChileNod内容';
  
    s := xmlDoc.XML.Text ; // .XML 返回的是 Tstrings
finally
    xmlDoc := nil ;
end;

(3)利用 XMLDataBinding
    I) 准备好XML文件，此XML文件有较强的代表性，保证程序中所用的结点及其关系都存在
   II)利用 file-->new-->XML Data Binding
III)创建XML对象
   A)v:string; //XML文件内容
    Doc : IXMLBudgetDocTyp; //IXMLBudgetDocTyp是XML文件的根结点
    Doc := LoadXMLData(v).GetDocBinding('BudgetDoc', TXMLBudgetDocType) as IXMLBudgetDocType;
   B)Doc := LoadBudgetDoc('C:\temp.xml');
IV) 应用
    Doc.ChildNodes.FindNode('Docfile') as IXMLDocfileType;

(4)利用TXMLDocument控件
    XMLDocument1.fileName:='C:\temp.xml';
    XMLDocument1.active:=true; // XMLDocument1 相当于 Doc

(5)XML对象的其他方法
   IXMLNodeList.FindNode(NodeName: DOMString): IXMLNode;
   IXMLNodeList.FindNode(NodeName, NamespaceURI: DOMString): IXMLNode;
   IXMLNodeList.FindNode(ChildNodeType: TGuid): IXMLNode;
   IXMLNodeList.FindSibling(const Node: IXMLNode; Delta: Integer): IXMLNode;
   IXMLNodeList.First: IXMLNode;
   IXMLNodeList.Last: IXMLNode;
   ... ...
   
////////////////////////////////////////////////////////////////////////
//例(1)
uses msxml;  
    doc:IXMLDOMDocument;
    budgetdoc:ixmlDomNode;
    Rela:IxmlDOMNode;
    rs:ixmldomnodelist;

//建立或取得XML结点
doc := CoDOMDocument.create;
doc.load('C:\temp.xml');
budgetDoc := doc.selectSingleNode('BudgetDoc');
rela := budgetdoc.SelectSingleNode('Relation');

//创建XML子结点
if not assigned(rela) then
begin
    rela := doc.createElement('Relation');
    rela.setAttribute('BudgetId',0);
    rela.setAttribute('name','名称');
    budgetdoc.appendChild(rela);
end;

//取子结点(序列)
rs := rela.selectNodes('Rela[@BudgetId="2" and @TaskId="8"]');
for i := 0 to rs.length -1 do
begin
    s:= s + rs[i].attributes.getnameditem('NewRate').nodeValue;
end;

rela:=doc.ChildNodes.FindNode('DOMNode') as IxmlDOMNode;

//移除子结点
    for i := rs.length -1 downto 1 do
      rela.removeChild(rs[i])

//取父结点
    if assigned(anode.parentNode) and (Anode.parentNode.nodeName='Task') then
      result := Anode.parentNode;

//取属性
DOC.DocumentElement.Attributes['Name']
rela.Attributes['Name']
rs.Nodes[i].Attributes['Name']

Ajob:ixmldomnode；jobs:ixmldomNodeList;
jobs := Ajob.selectNodes('RCJ[@Attrib="'+AAttrib+'"]').