0

我有如下所示的 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 中获取值并将其包含在消息中？

4

2 回答 2

5

您可以使用 XPath 表达式获取 USERNAME 标记的值，例如/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.
于 2013-05-01T17:12:49.617 回答
1

You can use XPath to access values in an XML file very easily, as the following sample code demonstrates.

(NB: This code assumes Delphi 2010+ and Win target).

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;

The above code fragment uses a couple of utility units referenced in the blog entry, which I copy below for convenience.

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.

unit uXMLUtils

unit uXMLUtils; interface uses 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.
于 2013-05-02T06:46:07.800 回答