在Delphi中訪問XML文檔的一部分

Question

我已經使用delphi數據綁定向導和我的xml文件，並且所有內容都可以編譯並運行正常。

我的窗體上有3個組合框。製造商，型號和年份。

在FormCreate上使用以下代碼填充製造商。

procedure TfrmMain.FormCreate(Sender: TObject); 
var 
    RGearing : IXMLracegearingType; 
    i : Integer; 
begin 
    // Load XML Document into Memory 
    RGearing := Getracegearing(XMLDocument1); 

    // Populate Manufacturer combobox 
    for i := 0 to RGearing.Car.Count-1 do 
    begin 
    cbManufac.Items.Add(RGearing.Car[i].Manufacturer); 
    end; 

    // Copy current selected Manufacturer to string variable 
    varManufac := cbManufac.ListItems[(cbManufac.ItemIndex)].Text; 
end; 

我的問題是如何根據當前選定的製造商填充模型組合框。

這裏是去與它

<?xml version="1.0" encoding="UTF-8"?> 
<gearing> 
    <car> 
    <id>1</id> 
    <manufacturer>Ford</manufacturer> 
    <model>Test 1</model> 
    <year></year> 
    </car> 
    <car> 
    <id>2</id> 
    <manufacturer>Ford</manufacturer> 
    <model>Test 2</model> 
    <year></year> 
    </car> 
    <car> 
    <id>3</id> 
    <manufacturer>Honda</manufacturer> 
    <model>Test 1</model> 
    <year></year> 
    </car> 
    <settings> 
    <form_height></form_height> 
    <form_width></form_width> 
    </settings> 
</gearing> 

因此，如果選擇的製造商福特那麼模型組合框需要顯示測試1和測試2作爲項的XML文件。

Answer 1

我看不到你的函數和類

RGearing : IXMLracegearingType; 
RGearing :=Getracegearing(XMLDocument1); 

，所以我可以只用下面的代碼測試它。
瀏覽代碼並根據您的需求進行定製。

unit xmlCombo; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls; 

type 
    TForm1 = class(TForm) 
    cbManufac: TComboBox; 
    cbModel: TComboBox; 
    procedure getManufac; 
    procedure getModel(const ManufacVal:string); 
    procedure FormActivate(Sender: TObject); 
    procedure cbManufacClick(Sender: TObject); 
    private 
    { Private-Deklarationen } 
    public 
    { Public-Deklarationen } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 
uses MSXML,ActiveX,ComObj; 

const 
XMLTestStr = 
'<?xml version="1.0" encoding="UTF-8"?>'+ 
'<gearing>'+ 
' <car>'+ 
' <id>1</id>'+ 
' <manufacturer>Ford</manufacturer>'+ 
' <model>Test 1</model>'+ 
' <year></year>'+ 
' </car>'+ 
' <car>'+ 
' <id>2</id>'+ 
' <manufacturer>Ford</manufacturer>'+ 
' <model>Test 2</model>'+ 
' <year></year>'+ 
' </car>'+ 
' <car>'+ 
' <id>3</id>'+ 
' <manufacturer>Honda</manufacturer>'+ 
' <model>Test 1</model>'+ 
' <year></year>'+ 
' </car>'+ 
' <settings>'+ 
' <form_height></form_height>'+ 
' <form_width></form_width>'+ 
' </settings>'+ 
'</gearing>'; 

var 
    varManufac : string; 
    RGearing : IXMLDOMDocument; 

procedure TForm1.cbManufacClick(Sender: TObject); 
begin 
    getModel(cbManufac.Items[cbManufac.ItemIndex]); 
end; 

procedure TForm1.FormActivate(Sender: TObject); 
begin 
    RGearing:=CoDOMDocument.Create; 
    RGearing.loadXML(XmlTestStr); 
    getManufac; 
end; 

procedure TForm1.getModel(const ManufacVal:string); 
Var 
    XMLDOMNodeL : IXMLDOMNodeList; 
    ChildST : String; 
    ChildN,BNode : IXMLDOMNode; 
    i : Integer; 

begin 
    cbModel.Items.Clear; 
    cbModel.Text:=''; 
    XMLDOMNodeL:=RGearing.getElementsByTagName('car'); 
    for i := 0 to XMLDOMNodeL.length-1 do 
    begin 
    ChildN:=XMLDOMNodeL[i].selectSingleNode('manufacturer'); 
    if ChildN.text=ManufacVal then begin 
     BNode:=XMLDOMNodeL[i].selectSingleNode('model');   
     ChildST:=BNode.text; 
     if cbModel.Items.IndexOf(ChildST) = -1 then cbModel.Items.Add(ChildST); 
    end; 
    end; 
end; 

procedure TForm1.getManufac; 
Var 
    XMLDOMNodeList : IXMLDOMNodeList; 
    ChildST : string; 
    i : Integer; 

begin 
    cbManufac.Items.Clear; 
    cbManufac.Text:=''; 
    // Populate Manufacturer combobox 
    XMLDOMNodeList:=RGearing.getElementsByTagName('manufacturer'); 
    for i := 0 to XMLDOMNodeList.length-1 do 
    begin 
    ChildST:=XMLDOMNodeList[i].text; 
    if cbManufac.Items.IndexOf(ChildST) = -1 then cbManufac.Items.Add(ChildST); 
    if cbManufac.Items.Count = 1 then begin 
     cbManufac.Text:=ChildST; 
     getModel(ChildST); 
    end; 
    end; 
end; 

end. 

爲了從文件加載XML。

if RGearing.Load('File.xml') then 
    [...] 
else 
    ShowMessage('Could not load file : File.xml'); 
end; 

我希望這會有所幫助。

Answer 2

您可以使用XPath，嘗試這樣./gearing/car[manufacturer="Ford"]/model

這一個句子是一個基本的樣本

{$APPTYPE CONSOLE} 

uses 
    ActiveX, 
    Variants, 
    ComObj, 
    Classes, 
    SysUtils; 

const 
XMLStr = 
'<?xml version="1.0" encoding="UTF-8"?>'+ 
'<gearing>'+ 
' <car>'+ 
' <id>1</id>'+ 
' <manufacturer>Ford</manufacturer>'+ 
' <model>Test 1</model>'+ 
' <year></year>'+ 
' </car>'+ 
' <car>'+ 
' <id>2</id>'+ 
' <manufacturer>Ford</manufacturer>'+ 
' <model>Test 2</model>'+ 
' <year></year>'+ 
' </car>'+ 
' <car>'+ 
' <id>3</id>'+ 
' <manufacturer>Honda</manufacturer>'+ 
' <model>Test 1</model>'+ 
' <year></year>'+ 
' </car>'+ 
' <settings>'+ 
' <form_height></form_height>'+ 
' <form_width></form_width>'+ 
' </settings>'+ 
'</gearing>'; 



function GetModels(const manufacturer:string):TStringList; 
const 
    Msxml2_DOMDocument='Msxml2.DOMDocument.6.0'; 
var 
    XmlDoc   : OleVariant; 
    Nodes   : OleVariant; 
    lNodes   : Integer; 
    i    : Integer; 
begin 
    Result:=TStringList.Create; 
    //create an instance to the XML DOM 
    XmlDoc  := CreateOleObject(Msxml2_DOMDocument); 
    try 
    XmlDoc.Async := False; 
    XmlDoc.LoadXML(XMLStr); 
    XmlDoc.SetProperty('SelectionLanguage','XPath'); 
    //check for errors in the xml file 
     if (XmlDoc.parseError.errorCode <> 0) then 
     raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]); 

    //select the nodes with match with the expression 
    //sample ./gearing/car[manufacturer="Ford"]/model 
    Nodes := XmlDoc.selectNodes(Format('./gearing/car[manufacturer="%s"]/model',[manufacturer])); 
    //get the number of nodes selected 
    lNodes:= Nodes.Length; 
    //traverse the nodes 
    for i:=0 to lNodes- 1 do 
     Result.Add(Nodes.Item(i).Text); 

    finally 
    XmlDoc :=Unassigned; 
    end; 
end; 

Var 
Models : TStringList; 
begin 
try 
    CoInitialize(nil); 
    try 
     Models:=GetModels('Ford'); 
     try 
     Writeln(Models.Text); 
     finally 
     Models.Free; 
     end; 
    finally 
     CoUninitialize; 
    end; 
except 
    on E:Exception do 
     Writeln(E.Classname, ':', E.Message); 
end; 
Writeln('Press Enter to exit'); 
Readln; 
end.