我的XML看起来像这样：
<SPPROFILES>
<----DATA------>
<PROFILES>
<PROFILE>
<ID>--------------</ID>
<NAME>------------</NAME>
<USERNAME>-----------</USERNAME>
</PROFILE>
</PROFILES>
</SPPROFILES>
我想从XML获取用户名并显示它。
这是代码的一部分：
SFailedHMConnection = 'Could not connect to default database with username "-------".';
在用户名之后，它应该显示XML中的用户名，而不是“------”，那么如何从XML中获取值并将其包含在消息中？
答案 0 :(得分：5)
您可以使用类似/SPPROFILES/PROFILES/PROFILE/USERNAME
试试这个样本
{$APPTYPE CONSOLE}
uses
ComObj,
ActiveX,
Variants,
SysUtils;
const
XMLStr=
'<SPPROFILES>'+
' <PROFILES>'+
' <PROFILE>'+
' <ID>--------------</ID>'+
' <NAME>------------</NAME>'+
' <USERNAME>John Smith</USERNAME>'+
' </PROFILE>'+
' </PROFILES>'+
'</SPPROFILES>';
procedure test;
var
XmlDoc : OleVariant;
Node : OleVariant;
begin
XmlDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
try
XmlDoc.Async := False;
XmlDoc.LoadXML(XMLStr);
XmlDoc.SetProperty('SelectionLanguage','XPath');
if (XmlDoc.parseError.errorCode <> 0) then
raise Exception.CreateFmt('Error in Xml Data %s',[XmlDoc.parseError]);
Node :=XmlDoc.selectSingleNode('/SPPROFILES/PROFILES/PROFILE/USERNAME');
if not VarIsClear(Node) then
Writeln(Node.Text);
finally
XmlDoc:=Unassigned;
end;
end;
begin
try
CoInitialize(nil);
try
test;
except
on E:Exception do
begin
Writeln(E.Classname, ':', E.Message);
end;
end;
finally
CoUninitialize;
end;
Readln;
end.
答案 1 :(得分：1)
您可以使用XPath轻松访问XML文件中的值，如以下示例代码所示。
（注意：此代码假设Delphi 2010+和Win目标）。
procedure FailedShowConnectionMessage( const ConfigFileName: string);
// ConfigFileName is the name of the XML file.
const
SFailedHMConnection = 'Could not connect to default database with username "%s".';
SUserXPathExpression = '/SPPROFILES/PROFILES/PROFILE/USERNAME/text()';
var
UserNode: IXMLNode;
Doc: IXMLDocument;
DocStream: TStream;
begin
DocStream := TFileStream.Create( ConfigFileName, fmOpenRead);
try
Doc := uXMLUtils.LoadDocument_MSXML_FromStream( DocStream)
finally
DocStream.Free
end;
if uXMLUtils.XPATHSelectFirst( Doc.Node, SUserXPathExpression, UserNode) then
ShowMessageFmt(SFailedHMConnection, [UserNode.Text])
end;
上面的代码片段使用blog entry中引用的几个实用程序单元，为方便起见，我在下面复制。
unit uEnumeration
unit uEnumeration;
interface
uses SysUtils;
type
TEnumerableBase = class abstract( TInterfacedObject, IEnumerable)
protected
function GetBaseEnumerator: IEnumerator; virtual; abstract;
function IEnumerable.GetEnumerator = GetBaseEnumerator;
end;
TEnumerator_Intf<T> = class;
TEnumerable_Intf<T> = class( TEnumerableBase, IEnumerable<T>)
private
function GetIntfEnumerator: IEnumerator<T>;
function IEnumerable<T>.GetEnumerator = GetIntfEnumerator;
protected
function GetBaseEnumerator: IEnumerator; override;
function CreateEnumerator : TEnumerator_Intf<T>; virtual; abstract;
end;
TEnumeratorBase = class( TInterfacedObject, IEnumerator)
protected
function GetCurrentObj : TObject; virtual; abstract;
function IEnumerator.GetCurrent = GetCurrentObj;
function MoveNext: Boolean; virtual; abstract;
procedure Reset; virtual;
end;
TEnumerator_Intf<T> = class( TEnumeratorBase, IEnumerator<T>)
protected
FEnumerable: TEnumerable_Intf<T>;
FCurrent: T;
function GetCurrentObj : TObject; override;
function GetCurrentIntf: T; virtual;
function IEnumerator<T>.GetCurrent = GetCurrentIntf;
public
constructor Create( Enumerable1: TEnumerable_Intf<T>); virtual;
property Current: T read GetCurrentIntf;
end;
implementation
{ TEnumerable_Intf<T> }
function TEnumerable_Intf<T>.GetBaseEnumerator: IEnumerator;
begin
result := GetIntfEnumerator
end;
function TEnumerable_Intf<T>.GetIntfEnumerator: IEnumerator<T>;
begin
result := CreateEnumerator
end;
{ TEnumeratorBase }
procedure TEnumeratorBase.Reset;
begin
end;
{ TEnumerator_Intf<T> }
constructor TEnumerator_Intf<T>.Create( Enumerable1: TEnumerable_Intf<T>);
begin
FEnumerable := Enumerable1
end;
function TEnumerator_Intf<T>.GetCurrentIntf: T;
begin
result := FCurrent
end;
function TEnumerator_Intf<T>.GetCurrentObj: TObject;
begin
result := self
end;
end.
单位uXMLUtils
单位uXMLUtils; 接口 使用XMLIntf，Classes;
type
XFocus = record // Record containing the focus node for an XPATH expression.
N: IXMLNode;
class operator Explicit( const N1: IXMLNode): XFocus;
class operator Divide( const a: XFocus; const b: string): IEnumerable<IXMLNode>;
class operator IntDivide( const a: XFocus; const b: string): IXMLNode;
class operator In( const a: string; const b: XFocus): boolean;
class operator Multiply( const a: XFocus; const StyleSheet: TStrings): IXMLDocument;
end;
// USAGE EXAMPLE:
// ==============
//var
// Cursor, Reference: IXMLNode;
//begin
//for Cursor in XFocus(Reference) / 'apple/@banana' do
// SomeAction( Cursor)
//end
function XPATHSelectFirst( const RefNode: IXMLNode; const XPATH: string; var SelectedNode: IXMLNode): boolean;
function XPATHSelect( const RefNode: IXMLNode; const XPATH: string): IEnumerable<IXMLNode>;
function XPATHBoolean( const poFocusNode: IXMLNode; const psXPath: string; pbDefault: boolean): boolean;
function LoadDocument_MSXML_FromStream ( InputDoc: TStream): IXMLDocument;
function LoadDocument_MSXML_FromString ( const InputDoc: string): IXMLDocument;
function LoadDocument_MSXML_FromUTF8String( const InputDoc: UTF8String): IXMLDocument;
function NewDocument_MSXML: IXMLDocument;
procedure DeclareSelectionNamespaces( const Doc: IXMLDocument;
const Namespaces: string {space separated list of namespace declarations});
function CloneNode( const Original: IXMLNode): IXMLNode;
function TransformXSLT1( const Focus: IXMLNode; StyleSheet: TStrings): IXMLDocument;
implementation
uses msxml, msxmldom, XMLDoc, xmldom, Generics.Collections,
uEnumeration, SysUtils;
type
IXMLDOMDocument2 = interface(IXMLDOMDocument)
['{2933BF95-7B36-11D2-B20E-00C04F983E60}']
function Get_namespaces: IXMLDOMSchemaCollection; safecall;
function Get_schemas: OleVariant; safecall;
procedure _Set_schemas(otherCollection: OleVariant); safecall;
function validate: IXMLDOMParseError; safecall;
procedure setProperty(const name: WideString; value: OleVariant); safecall;
function getProperty(const name: WideString): OleVariant; safecall;
property namespaces: IXMLDOMSchemaCollection read Get_namespaces;
property schemas: OleVariant read Get_schemas write _Set_schemas;
end;
function LoadDocument_MSXML_FromStream( InputDoc: TStream): IXMLDocument;
var
Doc: TXMLDocument;
XMLDOMNodeRef: IXMLDOMNodeRef;
Dom2: IXMLDOMDocument2;
begin
Doc := TXMLDocument.Create( nil);
Doc.Options := [doNodeAutoCreate, doNodeAutoIndent, doAttrNull,
doAutoPrefix, doNamespaceDecl];
Doc.DOMVendor := GetDOMVendor( 'MSXML');
if assigned( InputDoc) then
Doc.LoadFromStream( InputDoc);
Doc.Active := True;
result := Doc as IXMLDocument;
if Supports( result.DOMDocument, IXMLDOMNodeRef, XMLDOMNodeRef) and
Supports( XMLDOMNodeRef.GetXMLDOMNode, IXMLDOMDocument2, Dom2) and
(Dom2.getProperty( 'SelectionLanguage') <> 'XPath') then
Dom2.setProperty( 'SelectionLanguage', 'XPath')
end;
procedure DeclareSelectionNamespaces( const Doc: IXMLDocument;
const Namespaces: string {space separated list of namespace declarations});
var
XMLDOMNodeRef: IXMLDOMNodeRef;
Dom2: IXMLDOMDocument2;
begin
if Supports( Doc.DOMDocument, IXMLDOMNodeRef, XMLDOMNodeRef) and
Supports( XMLDOMNodeRef.GetXMLDOMNode, IXMLDOMDocument2, Dom2) then
Dom2.setProperty( 'SelectionNamespaces', Namespaces)
end;
function NewDocument_MSXML: IXMLDocument;
begin
result := LoadDocument_MSXML_FromStream( nil)
end;
function LoadDocument_MSXML_FromString ( const InputDoc: string): IXMLDocument;
var
Source: TStream;
begin
Source := TStringStream.Create( InputDoc);
try
result := LoadDocument_MSXML_FromStream( Source)
finally
Source.Free
end
end;
function LoadDocument_MSXML_FromUTF8String( const InputDoc: UTF8String): IXMLDocument;
var
Source: TStream;
begin
Source := TStringStream.Create( InputDoc, TEncoding.UTF8);
try
result := LoadDocument_MSXML_FromStream( Source)
finally
Source.Free
end
end;
function XPATHSelectFirst( const RefNode: IXMLNode; const XPATH: string; var SelectedNode: IXMLNode): boolean;
var
Node: IXMLNode;
begin
result := False;
SelectedNode := nil;
for Node in XPATHSelect( RefNode, XPATH) do
begin
result := True;
SelectedNode := Node;
break
end
end;
type
TEnumerable_XMLNode_by_XPATHSelect = class( TEnumerable_Intf<IXMLNode>)
private
FDOMNodes: IDOMNodeList;
protected
function CreateEnumerator : TEnumerator_Intf<IXMLNode>; override;
public
constructor Create( const RefNode: IXMLNode; const XPATH: string);
end;
TEnumerator_XMLNode_by_XPATHSelect = class( TEnumerator_Intf<IXMLNode>)
private
FDOMNodes: IDOMNodeList;
FIdx : integer;
protected
function MoveNext: Boolean; override;
procedure Reset; override;
public
constructor Create( Enumerable1: TEnumerable_Intf<IXMLNode>); override;
end;
function XPATHSelect( const RefNode: IXMLNode; const XPATH: string): IEnumerable<IXMLNode>;
begin
result := TEnumerable_XMLNode_by_XPATHSelect.Create( RefNode, XPATH)
end;
function XPATHBoolean( const poFocusNode: IXMLNode; const psXPath: string; pbDefault: boolean): boolean;
var
SelectedNode: IXMLNode;
StringValue: string;
begin
if XPATHSelectFirst( poFocusNode, psXPath, SelectedNode) then
begin
StringValue := LowerCase( SelectedNode.Text);
result := (StringValue = 'true') or
(StringValue = '1') or
(StringValue = 'y')
end
else
result := pbDefault
end;
function CloneNode( const Original: IXMLNode): IXMLNode;
procedure Touch( const Node: IXMLNode);
var
iChild: integer;
begin
for iChild := 0 to Node.ChildNodes.Count - 1 do
Touch( Node.ChildNodes.Get( iChild));
end;
begin
result := Original.CloneNode( True);
Touch( result);
end;
{ TEnumerable_XMLNode_by_XPATHSelect }
constructor TEnumerable_XMLNode_by_XPATHSelect.Create(
const RefNode: IXMLNode; const XPATH: string);
var
DomNodeSelect: IDomNodeSelect;
begin
FDOMNodes := nil;
if assigned( RefNode) and
Supports( RefNode.DOMNode, IDomNodeSelect, DomNodeSelect) then
FDOMNodes := DomNodeSelect.SelectNodes( XPATH)
end;
function TEnumerable_XMLNode_by_XPATHSelect.CreateEnumerator: TEnumerator_Intf<IXMLNode>;
begin
result := TEnumerator_XMLNode_by_XPATHSelect.Create( self)
end;
{ TEnumerator_XMLNode_by_XPATHSelect }
constructor TEnumerator_XMLNode_by_XPATHSelect.Create(
Enumerable1: TEnumerable_Intf<IXMLNode>);
begin
inherited;
FIdx := -1;
FCurrent := nil;
FDOMNodes := (FEnumerable as TEnumerable_XMLNode_by_XPATHSelect).FDOMNodes;
FEnumerable := nil
end;
function TEnumerator_XMLNode_by_XPATHSelect.MoveNext: Boolean;
var
DOMNode : IDomNode;
DocAccess : IXmlDocumentAccess;
Doc : TXmlDocument;
begin
result := assigned( FDOMNodes) and (FIdx <= (FDOMNodes.length - 1));
if not result then exit;
Inc( FIdx);
result := FIdx <= (FDOMNodes.length - 1);
if result then
begin
Doc := nil;
DOMNode := FDOMNodes.item[FIdx];
if Supports( DOMNode, IXmlDocumentAccess, DocAccess) then
Doc := DocAccess.DocumentObject;
FCurrent := TXmlNode.Create( DOMNode, nil, Doc) as IXMLNode
end
else
FCurrent := nil
end;
procedure TEnumerator_XMLNode_by_XPATHSelect.Reset;
begin
inherited;
FIdx := -1
end;
{ XFocus }
class operator XFocus.Explicit( const N1: IXMLNode): XFocus;
begin
result.N := N1
end;
class operator XFocus.Divide( const a: XFocus; const b: string): IEnumerable<IXMLNode>;
begin
result := XPATHSelect( a.N, b)
end;
class operator XFocus.IntDivide( const a: XFocus; const b: string): IXMLNode;
begin
if not XPATHSelectFirst( a.N, b, result) then
result := nil
end;
class operator XFocus.In( const a: string; const b: XFocus): boolean;
var
Dummy: IXMLNode;
begin
result := XPATHSelectFirst( b.N, a, Dummy)
end;
class operator XFocus.Multiply( const a: XFocus; const StyleSheet: TStrings): IXMLDocument;
begin
result := TransformXSLT1( a.N, StyleSheet)
end;
function TransformXSLT1( const Focus: IXMLNode; StyleSheet: TStrings): IXMLDocument;
begin
result := NewDocument_MSXML;
Focus.TransformNode( LoadDocument_MSXML_FromString( StyleSheet.Text).Node, result)
end;
end.