xmlblocks.pas

Delphi XML & XPATH源代码

unit XMLBlocks;

{
  XML Building Blocks
  Plug-and-play components for working with XML expressed as DOM documents.
  Producers generate new XML documents as DOMs.
  Consumers use those DOMs to amend or process them.

  Included are:
  TXBBParser          - generate DOMs from existing documents
  TXBBSQL             - generates DOMs from database queries
  TXBBTextFile        - generates DOMs around a text file's contents
  TXBBComponent       - generates DOMs from Delphi component properties

  TXBBMerge           - combines several DOMs into one new DOM
  TXBBFork            - sends a DOM to several consumers

  TXBBTimestamp       - add a timestamp element to a DOM
  TXBBTransform       - apply an XSL transformation to a DOM

  TXBBWriter          - send a DOM to a file or stream
  TXBBTreeView        - display a DOM in a tree view
  TXBBMemo            - display a DOM in a memo
  TXBBStringGrid      - display a DOM in a string grid
  TXBBWebBrowser      - display a DOM in a Web browser
  TXBBComponentCreate - create a component from the DOM

  Written by Keith Wood ([e-mail])
  Version 1.0 - 7 March 2002.
}

interface

uses
  Classes, SysUtils, StrUtils, Math, Graphics, Controls, ComCtrls, StdCtrls,
  ImgList, Grids, DB, DBTables, ShDocVw, ActiveX, XMLDOM;

type
  { Definition for the user of an XML document in DOM format }
  IXMLConsumer = interface
    ['{917863FF-96D1-40F9-9868-926D9C299068}']
    { Pass the DOM document along to be used and start processing it }
    procedure DocumentReady(Document: IDOMDocument);
  end;

  { Definition for the generator of an XML document in DOM format }
  IXMLProducer = interface
    ['{B53AF472-4B85-4F98-98B4-48501C81AE6A}']
    { Generate a new XML document and pass it to the consumer }
    procedure CreateDocument;
    function GetConsumer: IXMLConsumer;
    procedure SetConsumer(const Value: IXMLConsumer);
    { The consumer makes use of the new document }
    property Consumer: IXMLConsumer read GetConsumer write SetConsumer;
  end;

  { An XML Building Blocks specific exception }
  EXBBException = class(Exception)
  end;

  { Event to modify a newly created element }
  TXBBTagCreateEvent = procedure (Sender: TObject; Element: IDOMElement)
    of object;

  { Base class for developing consumers and producers.
    It's producer part (CreateDocument) does nothing. Override this for
    a new producer to actually generate the document and call DocumentReady.
    It's consumer part (DocumentReady) calls ProcessDocument to work on
    the document, then passes it along to any attached consumer.
    ProcessDocument just returns the original document without change.
    Override this for a new consumer. }
  TXMLBuildingBlock = class(TComponent, IXMLConsumer, IXMLProducer)
  private
    FConsumer: IXMLConsumer;
    FOnTagCreate: TXBBTagCreateEvent;
    FTagName: string;
    function GetConsumer: IXMLConsumer;
    procedure SetConsumer(const Value: IXMLConsumer);
  protected
    property Consumer: IXMLConsumer read GetConsumer write SetConsumer;
    property TagName: string read FTagName write FTagName;
    property OnTagCreate: TXBBTagCreateEvent read FOnTagCreate
      write FOnTagCreate;
    procedure DoOnTagCreate(Element: IDOMElement);
    function NewDocument(const TagName: string): IDOMDocument; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure NotifyConsumer(Document: IDOMDocument);
    function ProcessDocument(const Document: IDOMDocument): IDOMDocument; virtual;
  public
    procedure CreateDocument; virtual;
    procedure DocumentReady(Document: IDOMDocument); virtual;
  end;

  { Create a new DOM from an existing XML document.
    The document can come from an existing file (XMLSource),
    from a stream (XMLStream), or from memory (XMLText). }
  TXBBParser = class(TXMLBuildingBlock)
  private
    FXMLSource: TFileName;
    FXMLStream: TStream;
    FXMLText: TStrings;
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; const XMLSource: TFileName);
      reintroduce; overload;
    constructor Create(AOwner: TComponent; const XMLStream: TStream);
      reintroduce; overload;
    constructor Create(AOwner: TComponent; const XMLText: TStrings);
      reintroduce; overload;
    destructor Destroy; override;
    procedure CreateDocument; override;
  published
    property Consumer;
    property XMLSource: TFileName read FXMLSource write FXMLSource;
    property XMLStream: TStream read FXMLStream write FXMLStream;
    property XMLText: TStrings read FXMLText write FXMLText;
  end;

  { Event to modify a newly created record element }
  TXBBRecordTagCreateEvent = procedure (Sender: TObject; Element: IDOMElement;
    Dataset: TDataSet) of object;

  TXBBFieldFormat = (xfText, xfElement, xfAttributeOnly);

  { Create a new DOM from an SQL query.
    The DatabaseName and SQL properties retrieve data which is then made
    into an XML document. The top-level tag is named according to the
    TagName property, or from the DatabaseName if this is blank.
    Each row from the query becomes an element under this, using
    RecordTagName as its name, or 'record' if this is blank.
    Fields from the query then become child elements of the record,
    with names taken from the field name, and contents as text or
    CDATA section (if they contain '<' or '>') nodes. }
  TXBBSQL = class(TXMLBuildingBlock)
  private
    FDatabaseName: string;
    FFieldFormat: TXBBFieldFormat;
    FOnRecordTagCreate: TXBBRecordTagCreateEvent;
    FRecordTagName: string;
    FSQL: TStrings;
    procedure GetText(Sender: TField; var Text: String; DisplayText: Boolean);
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; const TagName: string);
      reintroduce; overload;
    constructor Create(AOwner: TComponent; const DatabaseName: string;
      const SQL: TStrings; const TagName: string = ''); reintroduce; overload;
    destructor Destroy; override;
    procedure CreateDocument; override;
  published
    property Consumer;
    property DatabaseName: string read FDatabaseName write FDatabaseName;
    property FieldFormat: TXBBFieldFormat read FFieldFormat write FFieldFormat
      default xfText;
    property RecordTagName: string read FRecordTagName write FRecordTagName;
    property SQL: TStrings read FSQL write FSQL;
    property TagName;
    property OnRecordTagCreate: TXBBRecordTagCreateEvent read FOnRecordTagCreate
      write FOnRecordTagCreate;
    property OnTagCreate;
  end;

  { Create a new DOM around the contents of a text file.
    The FileName property locates the file which is then made
    into an XML document. The top-level tag is named according to the
    TagName property, or 'file' if this is blank. It contains a single
    text or CDATA section node (depending on the AsCDATA property)
    that has the file's contents. }
  TXBBTextFile = class(TXMLBuildingBlock)
  private
    FAsCDATA: Boolean;
    FFileName: TFileName;
  public
    constructor Create(AOwner: TComponent; const FileName: TFileName = '';
      const TagName: string = ''); reintroduce; overload;
    procedure CreateDocument; override;
  published
    property AsCDATA: Boolean read FAsCDATA write FAsCDATA default False;
    property Consumer;
    property FileName: TFileName read FFileName write FFileName;
    property TagName;
    property OnTagCreate;
  end;

  { Create a new DOM around the properties of a component.
    Components appear within 'object' elements with 'name' and 'type'
    attributes. Properties appear within embedded 'property' elements
    with 'name' and 'value' attributes. Collections items appear as
    'item' elements within a property. }
  TXBBComponent = class(TXMLBuildingBlock)
  private
    FComponent: TComponent;
  public
    constructor Create(AOwner: TComponent; const TagName: string = '';
      const Component: TComponent = nil); reintroduce; overload;
    procedure CreateDocument; override;
  published
    property Component: TComponent read FComponent write FComponent;
    property Consumer;
    property TagName;
    property OnTagCreate;
  end;

  { Write out the DOM to a given file or stream.
    Set one of FileName or Stream before using this component. }
  TXBBWriter = class(TXMLBuildingBlock)
  private
    FFileName: TFileName;
    FStream: TStream;
  protected
    function ProcessDocument(const Document: IDOMDocument): IDOMDocument;
      override;
  public
    constructor Create(AOwner: TComponent; const FileName: TFileName);
      reintroduce; overload;
    constructor Create(AOwner: TComponent; const Stream: TStream);
      reintroduce; overload;
  published
    property Consumer;
    property FileName: TFileName read FFileName write FFileName;
    property Stream: TStream read FStream write FStream;
  end;

  { Merge several DOM documents together in a new document under a new
    main element (named from the TagName property).
    Set the number of documents to expect with the NumDocuments property.
    When this many have appeared via the DocumentReady method and been
    combined, they are sent on to this component's consumer.
    Reset the component for another combination by setting NumDocuments again. }
  TXBBMerge = class(TXMLBuildingBlock)
  private
    FCountDown: Integer;
    FMergedDocument: IDOMDocument;
    FNumDocuments: Integer;
    procedure SetNumDocuments(Value: Integer);
  public
    constructor Create(AOwner: TComponent; const NumDocuments: Integer = 2;
      const TagName: string = ''); reintroduce; overload;
    procedure DocumentReady(Document: IDOMDocument); override;
  published
    property Consumer;
    property NumDocuments: Integer read FNumDocuments write SetNumDocuments;
    property TagName;
    property OnTagCreate;
  end;

  { A consumer item for a collection. }
  TXBBConsumerCollectionItem = class(TCollectionItem)
  private
    FConsumer: IXMLConsumer;
    FName: string;
    procedure SetConsumer(Value: IXMLConsumer);
    procedure SetName(Value: string);
  protected
    function GetDisplayName: string; override;
  published
    property Consumer: IXMLConsumer read FConsumer write SetConsumer;
    property Name: string read FName write SetName;
  end;

  { A collection of consumers. }
  TXBBConsumerCollection = class(TCollection)
  private
    FOwner: TPersistent;
  protected
    function GetItem(Index: Integer): TXBBConsumerCollectionItem;
    function  GetOwner: TPersistent; override;
    procedure SetItem(Index: Integer; Value: TXBBConsumerCollectionItem);
  public
    constructor Create(Owner: TPersistent);
    function Add: TXBBConsumerCollectionItem;
    function FindItemID(ID: Integer): TXBBConsumerCollectionItem;
    function Insert(Index: Integer): TXBBConsumerCollectionItem;
    property Items[Index: Integer]: TXBBConsumerCollectionItem
      read GetItem write SetItem;
  end;

  { Pass a DOM document off to several consumers. }
  TXBBFork = class(TXMLBuildingBlock)
  private
    FConsumers: TXBBConsumerCollection;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DocumentReady(Document: IDOMDocument); override;
  published
    property Consumers: TXBBConsumerCollection read FConsumers write FConsumers;
  end;

  { Apply an XSL transformation to a DOM document.
    The document can come from an existing file (XSLSource),
    from a stream (XSLStream), or from memory (XSLText). }
  TXBBTransform = class(TXMLBuildingBlock)
  private
    FXSLSource: TFileName;
    FXSLStream: TStream;
    FXSLText: TStrings;
  protected
    function ProcessDocument(const Document: IDOMDocument): IDOMDocument;
      override;
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; const XSLSource: TFileName);
      reintroduce; overload;
    constructor Create(AOwner: TComponent; const XSLStream: TStream);
      reintroduce; overload;
    constructor Create(AOwner: TComponent; const XSLText: TStrings);
      reintroduce; overload;
    destructor Destroy; override;
  published
    property Consumer;
    property XSLSource: TFileName read FXSLSource write FXSLSource;
    property XSLStream: TStream read FXSLStream write FXSLStream;
    property XSLText: TStrings read FXSLText write FXSLText;
  end;

  { Add a timestamp to a DOM. The timestamp appears as a separate element
    named from the TagName property (or 'timestamp' if that is blank)
    that appears first or last under the existing document's
    main element (depending on the InsertAtStart property.
    The Format property defines the appearance of the timestamp and uses the
    same notation as required by the FormatDateTime function.
    Format can be extended to generate multiple date parts beneath the
    timestamp element. Separate sub-elements with vertical bars ( | ),
    and sub-element names from formats with equals ( = ). For example,
    a Format of 'year=yyyy|month=MM|day=dd' creates the following structure:
    <timestamp><year>2002</year><month>03</month><day>07</day></timestamp>.
    Prefix a name with '@' to make it an attribute instead. For example,
    a Format of '@year=yyyy|@month=MM|@day=dd' creates the following structure:
    <timestamp year="2002" month="03" day="07"/>. }
  TXBBTimestamp = class(TXMLBuildingBlock)
  private
    FFormat: string;
    FInsertAtStart: Boolean;
    procedure SetFormat(const Value: string);
  protected
    function ProcessDocument(const Document: IDOMDocument): IDOMDocument;
      override;
  public
    constructor Create(AOwner: TComponent; const Format: string = '';
      const TagName: string = ''); reintroduce; overload;
  published
    property Consumer;
    property Format: string read FFormat write SetFormat;
    property InsertAtStart: Boolean read FInsertAtStart write FInsertAtStart;
    property TagName;
  end;

  { The node types }
  TXBBNodeType = (ntElement, ntAttribute, ntText, ntCDATA, ntEntityReference,
    ntEntity, ntProcessingInstr, ntComment, ntDocument, ntDocumentType,
    ntDocumentFragment, ntNotation);
  { The types of nodes to process }
  TXBBNodeTypes = set of TXBBNodeType;

  { An object wrapper of an interface for use in a tree. }
  TXBBNodePointer = class(TObject)
  public
    Node: IDOMNode;
    constructor Create(Node: IDOMNode);
  end;

  { Display a DOM within a tree view.
    The nodes as selected by the ShowNodes property are inserted into the
    attached tree view (TreeView property). Each node is assigned an
    image index corresponding to its node type. Assign an appropriate
    image list to the tree view to display these. You can use the
    DefaultNodeImages variable from this unit. }
  TXBBTreeView = class(TXMLBuildingBlock)
  private
    FShowNodes: TXBBNodeTypes;
    FTreeView: TTreeView;
    procedure SetTreeView(Value: TTreeView);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    function ProcessDocument(const Document: IDOMDocument): IDOMDocument;
      override;
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; const TreeView: TTreeView);
      reintroduce; overload;
    destructor Destroy; override;
    procedure ClearTree;
  published
    property Consumer;
    property ShowNodes: TXBBNodeTypes read FShowNodes write FShowNodes
      default [ntElement..ntNotation];
    property TreeView: TTreeView read FTreeView write SetTreeView;
  end;

  { Display a DOM within a memo.
    The XML text corresponding to the DOM is displayed in the attached
    memo (Memo property). }
  TXBBMemo = class(TXMLBuildingBlock)
  private
    FMemo: TMemo;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    function ProcessDocument(const Document: IDOMDocument): IDOMDocument;
      override;
  public
    constructor Create(AOwner: TComponent; const Memo: TMemo = nil);
      reintroduce; overload;
  published
    property Consumer;
    property Memo: TMemo read FMemo write FMemo;
  end;

  { Display a DOM within a string grid.
    The values from the nodes immediately beneath the document element
    in the document provided are displayed in the attached string grid
    (StringGrid property).
    If SingleNode is True (the default), the nodes are shown in two columns.
    The first is the node's name, the second is the node's value.
    If SingleNode is False, the nodes are assumed to be multiple copies of