Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 23 - Project XmlInterface

Project Structure

XmlInterface.dpr
program XmlInterface;

uses
  Forms,
  XmlIntfForm in 'XmlIntfForm.pas' {Form1},
  XmlIntfDefinition in 'XmlIntfDefinition.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
XmlIntfForm.pas
unit XmlIntfForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xmldom, XMLIntf, msxmldom, XMLDoc, StdCtrls;

type
  TForm1 = class(TForm)
    btnTitle: TButton;
    XMLDocument1: TXMLDocument;
    Memo1: TMemo;
    btnMemo: TButton;
    btnLoad: TButton;
    btnAttr: TButton;
    btnAllTitles: TButton;
    procedure btnTitleClick(Sender: TObject);
    procedure btnMemoClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure btnAttrClick(Sender: TObject);
    procedure btnAllTitlesClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  XmlIntfDefinition;

procedure TForm1.btnTitleClick(Sender: TObject);
var
  Books: IXMLBooksType;
begin
  Books := Getbooks (XmlDocument1); // as IXMLBooksType;
  // ShowMessage (Books.Book.Items[1].Title);
  ShowMessage (Books.Book[1].Title);
end;

procedure TForm1.btnMemoClick(Sender: TObject);
begin
  Memo1.Lines.Text :=
    FormatXMLData(XmlDocument1.XML.Text);
end;

procedure TForm1.btnLoadClick(Sender: TObject);
begin
  XmlDocument1.LoadFromFile (
    ExtractFilePath (Application.ExeName) + 'sample.xml');
end;

procedure TForm1.btnAttrClick(Sender: TObject);
var
  Books: IXMLBooksType;
begin
  Books := Getbooks (XmlDocument1);
  ShowMessage (Books.Text);
end;

procedure TForm1.btnAllTitlesClick(Sender: TObject);
var
  msg: string;
  I: Integer;
  Books: IXMLBooksType;
begin
  Books := Getbooks (XmlDocument1);
  msg := '';
  for I := 0 to Books.Book.Count - 1 do
    msg := msg + Books.Book.Items [I].Title + ' - ';
  for I := 0 to Books.Ebook.Count - 1 do
    msg := msg + Books.Ebook.Items [I].Title + ' - ';
  ShowMessage (msg);
  end;

end.
XmlIntfDefinition.pas

{***************************************************************}
{                                                               }
{                    Delphi XML Data Binding                    }
{                                                               }
{         Generated on: 6/4/2001 6:44:51 PM                     }
{       Generated from: C:\md6code\23\XmlInterface\Sample.xml   }
{                                                               }
{***************************************************************}
unit XmlIntfDefinition;

interface

uses xmldom, XMLDoc, XMLIntf;

type

{ Forward Decls }

  IXMLBooksType = interface;
  IXMLBookType = interface;
  IXMLBookTypeList = interface;
  IXMLEbookType = interface;
  IXMLEbookTypeList = interface;
  IXMLString_List = interface;

{ IXMLBooksType }

  IXMLBooksType = interface(IXMLNode)
    ['{C9A9FB63-47ED-4F27-8ABA-E71F30BA7F11}']
    { Property Accessors }
    function Get_Text: WideString;
    function Get_Book: IXMLBookTypeList;
    function Get_Ebook: IXMLEbookTypeList;
    procedure Set_Text(Value: WideString);
    { Methods & Properties }
    property Text: WideString read Get_Text write Set_Text;
    property Book: IXMLBookTypeList read Get_Book;
    property Ebook: IXMLEbookTypeList read Get_Ebook;
  end;

{ IXMLBookType }

  IXMLBookType = interface(IXMLNode)
    ['{26BF5C51-9247-4D1A-8584-24AE68969935}']
    { Property Accessors }
    function Get_Title: WideString;
    function Get_Author: IXMLString_List;
    procedure Set_Title(Value: WideString);
    { Methods & Properties }
    property Title: WideString read Get_Title write Set_Title;
    property Author: IXMLString_List read Get_Author;
  end;

{ IXMLBookTypeList }

  IXMLBookTypeList = interface(IXMLNodeCollection)
    ['{3449E8C4-3222-47B8-B2B2-38EE504790B6}']
    { Methods & Properties }
    function Add: IXMLBookType;
    function Insert(const Index: Integer): IXMLBookType;
    function Get_Item(Index: Integer): IXMLBookType;
    property Items[Index: Integer]: IXMLBookType read Get_Item; default;
  end;

{ IXMLEbookType }

  IXMLEbookType = interface(IXMLNode)
    ['{79F0237E-3596-40DD-ADBE-954AA7F6304F}']
    { Property Accessors }
    function Get_Title: WideString;
    function Get_Url: WideString;
    function Get_Author: WideString;
    procedure Set_Title(Value: WideString);
    procedure Set_Url(Value: WideString);
    procedure Set_Author(Value: WideString);
    { Methods & Properties }
    property Title: WideString read Get_Title write Set_Title;
    property Url: WideString read Get_Url write Set_Url;
    property Author: WideString read Get_Author write Set_Author;
  end;

{ IXMLEbookTypeList }

  IXMLEbookTypeList = interface(IXMLNodeCollection)
    ['{9713B729-340C-40EB-91AB-635FEF553EA5}']
    { Methods & Properties }
    function Add: IXMLEbookType;
    function Insert(const Index: Integer): IXMLEbookType;
    function Get_Item(Index: Integer): IXMLEbookType;
    property Items[Index: Integer]: IXMLEbookType read Get_Item; default;
  end;

{ IXMLString_List }

  IXMLString_List = interface(IXMLNodeCollection)
    ['{5DE9DF5D-9DE0-4654-B0D6-0CF330280950}']
    { Methods & Properties }
    function Add(const Value: WideString): IXMLNode;
    function Insert(const Index: Integer; const Value: WideString): IXMLNode;
    function Get_Item(Index: Integer): WideString;
    property Items[Index: Integer]: WideString read Get_Item; default;
  end;

{ Forward Decls }

  TXMLBooksType = class;
  TXMLBookType = class;
  TXMLBookTypeList = class;
  TXMLEbookType = class;
  TXMLEbookTypeList = class;
  TXMLString_List = class;

{ TXMLBooksType }

  TXMLBooksType = class(TXMLNode, IXMLBooksType)
  private
    FBook: IXMLBookTypeList;
    FEbook: IXMLEbookTypeList;
  protected
    { IXMLBooksType }
    function Get_Text: WideString;
    function Get_Book: IXMLBookTypeList;
    function Get_Ebook: IXMLEbookTypeList;
    procedure Set_Text(Value: WideString);
  public
    procedure AfterConstruction; override;
  end;

{ TXMLBookType }

  TXMLBookType = class(TXMLNode, IXMLBookType)
  private
    FAuthor: IXMLString_List;
  protected
    { IXMLBookType }
    function Get_Title: WideString;
    function Get_Author: IXMLString_List;
    procedure Set_Title(Value: WideString);
  public
    procedure AfterConstruction; override;
  end;

{ TXMLBookTypeList }

  TXMLBookTypeList = class(TXMLNodeCollection, IXMLBookTypeList)
  protected
    { IXMLBookTypeList }
    function Add: IXMLBookType;
    function Insert(const Index: Integer): IXMLBookType;
    function Get_Item(Index: Integer): IXMLBookType;
  end;

{ TXMLEbookType }

  TXMLEbookType = class(TXMLNode, IXMLEbookType)
  protected
    { IXMLEbookType }
    function Get_Title: WideString;
    function Get_Url: WideString;
    function Get_Author: WideString;
    procedure Set_Title(Value: WideString);
    procedure Set_Url(Value: WideString);
    procedure Set_Author(Value: WideString);
  end;

{ TXMLEbookTypeList }

  TXMLEbookTypeList = class(TXMLNodeCollection, IXMLEbookTypeList)
  protected
    { IXMLEbookTypeList }
    function Add: IXMLEbookType;
    function Insert(const Index: Integer): IXMLEbookType;
    function Get_Item(Index: Integer): IXMLEbookType;
  end;

{ TXMLString_List }

  TXMLString_List = class(TXMLNodeCollection, IXMLString_List)
  protected
    { IXMLString_List }
    function Add(const Value: WideString): IXMLNode;
    function Insert(const Index: Integer; const Value: WideString): IXMLNode;
    function Get_Item(Index: Integer): WideString;
  end;

{ Global Functions }

function Getbooks(Doc: IXMLDocument): IXMLBooksType;
function Loadbooks(const FileName: WideString): IXMLBooksType;
function Newbooks: IXMLBooksType;

implementation

{ Global Functions }

function Getbooks(Doc: IXMLDocument): IXMLBooksType;
begin
  Result := Doc.GetDocBinding('books', TXMLBooksType) as IXMLBooksType;
end;
function Loadbooks(const FileName: WideString): IXMLBooksType;
begin
  Result := LoadXMLDocument(FileName).GetDocBinding('books', TXMLBooksType) as IXMLBooksType;
end;

function Newbooks: IXMLBooksType;
begin
  Result := NewXMLDocument.GetDocBinding('books', TXMLBooksType) as IXMLBooksType;
end;

{ TXMLBooksType }

procedure TXMLBooksType.AfterConstruction;
begin
  RegisterChildNode('book', TXMLBookType);
  RegisterChildNode('ebook', TXMLEbookType);
  FBook := CreateCollection(TXMLBookTypeList, IXMLBookType, 'book') as IXMLBookTypeList;
  FEbook := CreateCollection(TXMLEbookTypeList, IXMLEbookType, 'ebook') as IXMLEbookTypeList;
  inherited;
end;

function TXMLBooksType.Get_Text: WideString;
begin
  Result := AttributeNodes['text'].Text;
end;

procedure TXMLBooksType.Set_Text(Value: WideString);
begin
  SetAttribute('text', Value);
end;

function TXMLBooksType.Get_Book: IXMLBookTypeList;
begin
  Result := FBook;
end;

function TXMLBooksType.Get_Ebook: IXMLEbookTypeList;
begin
  Result := FEbook;
end;

{ TXMLBookType }

procedure TXMLBookType.AfterConstruction;
begin
  FAuthor := CreateCollection(TXMLString_List, IXMLNode, 'author') as IXMLString_List;
  inherited;
end;

function TXMLBookType.Get_Title: WideString;
begin
  Result := ChildNodes['title'].Text;
end;

procedure TXMLBookType.Set_Title(Value: WideString);
begin
  ChildNodes['title'].NodeValue := Value;
end;

function TXMLBookType.Get_Author: IXMLString_List;
begin
  Result := FAuthor;
end;

{ TXMLBookTypeList }

function TXMLBookTypeList.Add: IXMLBookType;
begin
  Result := AddItem(-1) as IXMLBookType;
end;

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

function TXMLBookTypeList.Get_Item(Index: Integer): IXMLBookType;
begin
  Result := List[Index] as IXMLBookType;
end;

{ TXMLEbookType }

function TXMLEbookType.Get_Title: WideString;
begin
  Result := ChildNodes['title'].Text;
end;

procedure TXMLEbookType.Set_Title(Value: WideString);
begin
  ChildNodes['title'].NodeValue := Value;
end;

function TXMLEbookType.Get_Url: WideString;
begin
  Result := ChildNodes['url'].Text;
end;

procedure TXMLEbookType.Set_Url(Value: WideString);
begin
  ChildNodes['url'].NodeValue := Value;
end;

function TXMLEbookType.Get_Author: WideString;
begin
  Result := ChildNodes['author'].Text;
end;

procedure TXMLEbookType.Set_Author(Value: WideString);
begin
  ChildNodes['author'].NodeValue := Value;
end;

{ TXMLEbookTypeList }

function TXMLEbookTypeList.Add: IXMLEbookType;
begin
  Result := AddItem(-1) as IXMLEbookType;
end;

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

function TXMLEbookTypeList.Get_Item(Index: Integer): IXMLEbookType;
begin
  Result := List[Index] as IXMLEbookType;
end;

{ TXMLString_List }

function TXMLString_List.Add(const Value: WideString): IXMLNode;
begin
  Result := AddItem(-1);
  Result.NodeValue := Value;
end;


function TXMLString_List.Insert(const Index: Integer; const Value: WideString): IXMLNode;
begin
  Result := AddItem(Index);
  Result.NodeValue := Value;
end;


function TXMLString_List.Get_Item(Index: Integer): WideString;
begin
  Result := List[Index].NodeValue;
end;

end.
XmlIntfForm.dfm
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 580
  Height = 428
  Caption = 'XmlInterface'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    572
    401)
  PixelsPerInch = 96
  TextHeight = 13
  object btnTitle: TButton
    Left = 200
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Title'
    TabOrder = 0
    OnClick = btnTitleClick
  end
  object Memo1: TMemo
    Left = 24
    Top = 56
    Width = 524
    Height = 324
    Anchors = [akLeft, akTop, akRight, akBottom]
    TabOrder = 1
  end
  object btnMemo: TButton
    Left = 112
    Top = 16
    Width = 75
    Height = 25
    Caption = 'To Memo'
    TabOrder = 2
    OnClick = btnMemoClick
  end
  object btnLoad: TButton
    Left = 24
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Load'
    TabOrder = 3
    OnClick = btnLoadClick
  end
  object btnAttr: TButton
    Left = 288
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Attribute'
    TabOrder = 4
    OnClick = btnAttrClick
  end
  object btnAllTitles: TButton
    Left = 376
    Top = 16
    Width = 75
    Height = 25
    Caption = 'All Titles'
    TabOrder = 5
    OnClick = btnAllTitlesClick
  end
  object XMLDocument1: TXMLDocument
    NodeIndentStr = '      '
    Options = [doNodeAutoCreate, doNodeAutoIndent, doAttrNull, doAutoPrefix, doNamespaceDecl]
    Left = 176
    Top = 112
    DOMVendorDesc = 'MSXML'
  end
end