XML parsen, aber wie

[TiGü]

Ich lege nach und mache ein vollständiges Beispiel:

Delphi-Quellcode:

unit GetUID;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Net.HttpClient, System.Net.URLClient,
    System.Net.HttpClientComponent,
    Xml.xmldom, Xml.XMLDoc, Xml.XMLIntf,
    UID;

type
    TForm3 = class(TForm)
        btnSampleCall1: TButton;
        btnSampleCall2: TButton;
        NetHTTPClient1: TNetHTTPClient;  
        procedure btnSampleCall1Click(Sender: TObject);
        procedure btnSampleCall2Click(Sender: TObject);
    private
        procedure ShowResponse(const URL: string);
    end;

var
    Form3: TForm3;

implementation

{$R *.dfm}

// https://evatr.bff-online.de/eVatR/xmlrpc/http
const
    SAMPLE1 = 'https://evatr.bff-online.de/evatrRPC?UstId_1=DE123456789&UstId_2=AB1234567890&Firmenname=&Ort=&PLZ=&Strasse=';
    SAMPLE2 = 'https://evatr.bff-online.de/evatrRPC?UstId_1=DE123456789&UstId_2=AB1234567890&Firmenname=Firmenname einschl. Rechtsform&Ort=Ort der Firma&PLZ=12345&Strasse=Strasse der Firma';

procedure TForm3.btnSampleCall1Click(Sender: TObject);
begin
    ShowResponse(SAMPLE1);
end;

procedure TForm3.btnSampleCall2Click(Sender: TObject);
begin
    ShowResponse(SAMPLE2);
end;

procedure TForm3.ShowResponse(const URL: string);
var
    Response: IHTTPResponse;
    XmlDoc: IXMLDocument;
    RPCAnswer: UID.IXMLParamsType;
    Param: UID.IXMLParamType;
    Value, Value2: UID.IXMLValueType;
    I, J, K: Integer;
    DbgStr: string;
begin
    Response := NetHTTPClient1.Get(URL);
    XmlDoc := NewXMLDocument();
    XmlDoc.LoadFromXML(Response.ContentAsString());
    RPCAnswer := Getparams(XmlDoc);
    DbgStr := '';
    for I := 0 to RPCAnswer.Count - 1 do
    begin
        Param := RPCAnswer.Param[I];

        DbgStr := DbgStr + 'Param: ' + I.ToString + Param.Value.String_ + sLineBreak;

        for J := 0 to Param.Value.Array_.Data.Count - 1 do
        begin
            Value := Param.Value.Array_.Data.Value[J];

            if Value.String_ <> '' then
                DbgStr := DbgStr + '....Value ' + J.ToString + ' string: ' + Value.String_ + sLineBreak;

            // weitere Schachtelungen möglich, hier aber nicht in den beiden Beispielen
            for K := 0 to Value.Array_.Data.Count - 1 do
            begin
                Value2 := Value.Array_.Data.Value[K];
                if Value2.String_ <> '' then
                    DbgStr := DbgStr + '.......Value ' + K.ToString + ' string: ' + Value2.String_ + sLineBreak;
            end;
        end;
    end;
    ShowMessage(DbgStr);
end;

end.

mit der importierten XML über den XML Data Binding Wizard (Name der Unit hier mit UID gewählt, kann aber geändert werden):

Delphi-Quellcode:

{***************************************************}
{                                                   }
{                 XML Data Binding                  }
{                                                   }
{         Generated on: 22.06.2021 13:59:22         }
{       Generated from: D:\Github-Repos\new 2.xml   }
{   Settings stored in: D:\Github-Repos\new 2.xdb   }
{                                                   }
{***************************************************}

unit UID;

interface

uses Xml.xmldom, Xml.XMLDoc, Xml.XMLIntf;

type

{ Forward Decls }

  IXMLParamsType = interface;
  IXMLParamType = interface;
  IXMLValueType = interface;
  IXMLArrayType = interface;
  IXMLDataType = interface;

{ IXMLParamsType }

  IXMLParamsType = interface(IXMLNodeCollection)
    ['{F262379E-19C8-4062-BEF9-78826C7E7FF0}']
    { Property Accessors }
    function Get_Param(Index: Integer): IXMLParamType;
    { Methods & Properties }
    function Add: IXMLParamType;
    function Insert(const Index: Integer): IXMLParamType;
    property Param[Index: Integer]: IXMLParamType read Get_Param; default;
  end;

{ IXMLParamType }

  IXMLParamType = interface(IXMLNode)
    ['{96DA74CC-1B8A-4368-AA9E-99464D25D589}']
    { Property Accessors }
    function Get_Value: IXMLValueType;
    { Methods & Properties }
    property Value: IXMLValueType read Get_Value;
  end;

{ IXMLValueType }

  IXMLValueType = interface(IXMLNode)
    ['{235C08FA-0EBB-41E4-A7FE-4123BFE0D250}']
    { Property Accessors }
    function Get_String_: UnicodeString;
    function Get_Array_: IXMLArrayType;
    procedure Set_String_(Value: UnicodeString);
    { Methods & Properties }
    property String_: UnicodeString read Get_String_ write Set_String_;
    property Array_: IXMLArrayType read Get_Array_;
  end;

{ IXMLArrayType }

  IXMLArrayType = interface(IXMLNode)
    ['{0A59A8A5-86DD-4D4B-B345-6D553493DC94}']
    { Property Accessors }
    function Get_Data: IXMLDataType;
    { Methods & Properties }
    property Data: IXMLDataType read Get_Data;
  end;

{ IXMLDataType }

  IXMLDataType = interface(IXMLNodeCollection)
    ['{B3867F76-837B-495B-AD2B-ACBCC3B50263}']
    { Property Accessors }
    function Get_Value(Index: Integer): IXMLValueType;
    { Methods & Properties }
    function Add: IXMLValueType;
    function Insert(const Index: Integer): IXMLValueType;
    property Value[Index: Integer]: IXMLValueType read Get_Value; default;
  end;

{ Forward Decls }

  TXMLParamsType = class;
  TXMLParamType = class;
  TXMLValueType = class;
  TXMLArrayType = class;
  TXMLDataType = class;

{ TXMLParamsType }

  TXMLParamsType = class(TXMLNodeCollection, IXMLParamsType)
  protected
    { IXMLParamsType }
    function Get_Param(Index: Integer): IXMLParamType;
    function Add: IXMLParamType;
    function Insert(const Index: Integer): IXMLParamType;
  public
    procedure AfterConstruction; override;
  end;

{ TXMLParamType }

  TXMLParamType = class(TXMLNode, IXMLParamType)
  protected
    { IXMLParamType }
    function Get_Value: IXMLValueType;
  public
    procedure AfterConstruction; override;
  end;

{ TXMLValueType }

  TXMLValueType = class(TXMLNode, IXMLValueType)
  protected
    { IXMLValueType }
    function Get_String_: UnicodeString;
    function Get_Array_: IXMLArrayType;
    procedure Set_String_(Value: UnicodeString);
  public
    procedure AfterConstruction; override;
  end;

{ TXMLArrayType }

  TXMLArrayType = class(TXMLNode, IXMLArrayType)
  protected
    { IXMLArrayType }
    function Get_Data: IXMLDataType;
  public
    procedure AfterConstruction; override;
  end;

{ TXMLDataType }

  TXMLDataType = class(TXMLNodeCollection, IXMLDataType)
  protected
    { IXMLDataType }
    function Get_Value(Index: Integer): IXMLValueType;
    function Add: IXMLValueType;
    function Insert(const Index: Integer): IXMLValueType;
  public
    procedure AfterConstruction; override;
  end;

{ Global Functions }

function Getparams(Doc: IXMLDocument): IXMLParamsType;
function Loadparams(const FileName: string): IXMLParamsType;
function Newparams: IXMLParamsType;

const
  TargetNamespace = '';

implementation

uses Xml.xmlutil;

{ Global Functions }

function Getparams(Doc: IXMLDocument): IXMLParamsType;
begin
  Result := Doc.GetDocBinding('params', TXMLParamsType, TargetNamespace) as IXMLParamsType;
end;

function Loadparams(const FileName: string): IXMLParamsType;
begin
  Result := LoadXMLDocument(FileName).GetDocBinding('params', TXMLParamsType, TargetNamespace) as IXMLParamsType;
end;

function Newparams: IXMLParamsType;
begin
  Result := NewXMLDocument.GetDocBinding('params', TXMLParamsType, TargetNamespace) as IXMLParamsType;
end;

{ TXMLParamsType }

procedure TXMLParamsType.AfterConstruction;
begin
  RegisterChildNode('param', TXMLParamType);
  ItemTag := 'param';
  ItemInterface := IXMLParamType;
  inherited;
end;

function TXMLParamsType.Get_Param(Index: Integer): IXMLParamType;
begin
  Result := List[Index] as IXMLParamType;
end;

function TXMLParamsType.Add: IXMLParamType;
begin
  Result := AddItem(-1) as IXMLParamType;
end;

function TXMLParamsType.Insert(const Index: Integer): IXMLParamType;
begin
  Result := AddItem(Index) as IXMLParamType;
end;

{ TXMLParamType }

procedure TXMLParamType.AfterConstruction;
begin
  RegisterChildNode('value', TXMLValueType);
  inherited;
end;

function TXMLParamType.Get_Value: IXMLValueType;
begin
  Result := ChildNodes['value'] as IXMLValueType;
end;

{ TXMLValueType }

procedure TXMLValueType.AfterConstruction;
begin
  RegisterChildNode('array', TXMLArrayType);
  inherited;
end;

function TXMLValueType.Get_String_: UnicodeString;
begin
  Result := ChildNodes['string'].Text;
end;

procedure TXMLValueType.Set_String_(Value: UnicodeString);
begin
  ChildNodes['string'].NodeValue := Value;
end;

function TXMLValueType.Get_Array_: IXMLArrayType;
begin
  Result := ChildNodes['array'] as IXMLArrayType;
end;

{ TXMLArrayType }

procedure TXMLArrayType.AfterConstruction;
begin
  RegisterChildNode('data', TXMLDataType);
  inherited;
end;

function TXMLArrayType.Get_Data: IXMLDataType;
begin
  Result := ChildNodes['data'] as IXMLDataType;
end;

{ TXMLDataType }

procedure TXMLDataType.AfterConstruction;
begin
  RegisterChildNode('value', TXMLValueType);
  ItemTag := 'value';
  ItemInterface := IXMLValueType;
  inherited;
end;

function TXMLDataType.Get_Value(Index: Integer): IXMLValueType;
begin
  Result := List[Index] as IXMLValueType;
end;

function TXMLDataType.Add: IXMLValueType;
begin
  Result := AddItem(-1) as IXMLValueType;
end;

function TXMLDataType.Insert(const Index: Integer): IXMLValueType;
begin
  Result := AddItem(Index) as IXMLValueType;
end;

end.

Ergibt bspw. für den zweiten Button:

Code:

[Window Title]
Getuidtest

[Content]
Param: 0
....Value 0 string: UstId_1
....Value 1 string: DE123456789
Param: 1
....Value 0 string: ErrorCode
....Value 1 string: 212
Param: 2
....Value 0 string: UstId_2
....Value 1 string: AB1234567890
Param: 3
....Value 0 string: Druck
....Value 1 string: nein
Param: 4
....Value 0 string: Erg_PLZ
Param: 5
....Value 0 string: Ort
....Value 1 string: Ort der Firma
Param: 6
....Value 0 string: Datum
....Value 1 string: 22.06.2021
Param: 7
....Value 0 string: PLZ
....Value 1 string: 12345
Param: 8
....Value 0 string: Erg_Ort
Param: 9
....Value 0 string: Uhrzeit
....Value 1 string: 14:59:16
Param: 10
....Value 0 string: Erg_Name
Param: 11
....Value 0 string: Gueltig_ab
Param: 12
....Value 0 string: Gueltig_bis
Param: 13
....Value 0 string: Strasse
....Value 1 string: Strasse der Firma
Param: 14
....Value 0 string: Firmenname
....Value 1 string: Firmenname einschl. Rechtsform
Param: 15
....Value 0 string: Erg_Str


[OK]