omnixmlproperties.pas

OmniXML源码

{ $OmniXML: OmniXML/OmniXMLProperties.pas,v 1.1.1.1 2004/04/17 11:16:33 mr Exp $ }

(*:XML helper unit. Contains a class to simplify creation of node-wrapper
   classes (classes that contain properties that map directly to the child nodes
   of some XML node).
   @author Primoz Gabrijelcic
   @desc <pre>
   (c) 2002 Primoz Gabrijelcic
   Free for personal and commercial use. No rights reserved.

   Author            : Primoz Gabrijelcic
   Creation date     : 2001-06-17
   Last modification : 2004-03-01
   Version           : 2.0a
</pre>*)(*
   History:
     2.0a: 2004-03-01
       - Adapted for OmniXMLUtils 1.19.
     2.0: 2003-12-12
       - Major modifications to allow reading of RSS files (and other XML
         documents, of course).
         - TGpXMLDoc is now a TGpXMLData, too.
         - *List classes can now drop the 'listTag' in the constructor. Root
           class node will be used as a list wrapper in this case.
         - Added indexed property Items[] to both *List classes.
         - Added Get/SetXMLAttrProp* to the TGpXMLData class.
         - Added Get/SetXMLPropCDATA to the TGpXMLData class.
     1.09: 2003-11-27
       - Renamed CreateChildren method into RecreateChildren to serve as a
         visual reminder that it may be called when children are already created
         (in which case old instances must be destroyed first).
     1.08b: 2003-04-20
       - Bug fixed: Clearing TGpXMLList did not clear associated nodes.
     1.08a: 2003-01-16
       - Fixed range check error in SetXMLPropDWORD.
     1.08: 2003-01-13
       - Removed processing of default values in SetXMLProp* setters - it was
         causing a confusion when used in conjunction with the Assign method.
     1.07: 2003-01-13
       - Added TGpXMLData.InitChildNodes that greatly simplifies data node
         initialization.
       - Fixed saving - volatile/private markers are now not saved in the
         document element node anymore.
     1.06a: 2003-01-08
       - Standalone AsString fixed to work with volatile nodes.
       - TGpXMLDoc.AsString fixed to twork with volatile nodes.
     1.06: 2003-01-07
       - Added TGpXMLVolatileData class. It is only returned as a part of the
         AsString result and is _not_ saved in the TGpXMLDoc.SaveTo* methods.
     1.05: 2002-12-26
       - Added '_' support to the TGpXMLData class.
       - Added parameterless constructor to the TGpXMLData class.
       - Added 'load from string' constructor to the TGpXMLData class.
       - Added property AsString to the TGpXMLData class.
     1.04: 2002-12-22
       - Added property AsString to the TGpXMLDoc class.
     1.03: 2002-12-09
       - MSXML compatible (define USE_MSXML).
     1.02: 2002-10-01
       - TXMLData now implements Text property allowing for text-only nodes.
     1.01a: 2002-05-15
       - Fixed bug in TGpXMLList.Delete.
     1.01: 2001-12-01
       - Added functions LoadFromString, LoadFromRegistry, SaveToString,
         SaveToRegistry to the TGpXMLDoc class.
       - Added parameter outputFormat to TGpXMLDoc.SaveToFile and
         TGpXMLDoc.SaveToStream.
       - New class TGpXMLDocList.
     1.0: 2001-10-24
       - Created by extracting database-related functionality from unit GpXML.
       - Implemented TGpXMLDoc.LoadFromStream and TGpXMLDoc.SaveToStream.
*)

unit OmniXMLProperties;

interface

{$I OmniXML.inc}

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFDEF LINUX}
  Types,  // declares DWORD
{$ENDIF}
  Classes,
  Contnrs,
  TypInfo,
{$IFDEF VER140}
  Variants,
{$ENDIF}
  OmniXML
{$IFDEF USE_MSXML}
  , OmniXML_MSXML
{$ENDIF}
  ;

// TODO 3 -oPrimoz Gabrijelcic: Convert Load/Save routines to use mr_XML error reporting system.

type
  TGpXMLList = class;

  {:Base class that handles most functionality of getting and setting XML-based
    properties. Derived class typically only has to declare indexed properties
    and initialize xmlChildNodeDefaults and xmlChildNodeTags arrays in the
    overridden constructor.
    Note that Int64 is not compatible with Variant. If you want to set the
    default value for a Int64 property, specify it as a string. GetXMLPropInt64
    will use StrToInt64 to convert default value into a number.
  }
  TGpXMLData = class
  private
    xmlList: TGpXMLList;
    xmlNode: IXMLNode;
  protected
    xmlChildNodeDefaults: array of Variant;
    xmlChildNodeTags    : array of string;
    xmlXMLDoc           : IXMLDocument;
    procedure FilterNodes(node: IXMLNode; var canProcess: boolean); virtual;
    procedure FilterPrivateNodes(node: IXMLNode; var canProcess: boolean); virtual;
    function  GetAsString: string; virtual;
    function  GetText: string; virtual;
    function  GetXMLAttrProp(index: integer): string; virtual;
    function  GetXMLAttrPropBool(index: integer): boolean; virtual;
    function  GetXMLAttrPropCardinal(index: integer): cardinal; virtual;
    function  GetXMLAttrPropDate(index: integer): TDateTime; virtual;
    function  GetXMLAttrPropDateTime(index: integer): TDateTime; virtual;
    function  GetXMLAttrPropDWORD(index: integer): DWORD; virtual;
    function  GetXMLAttrPropInt(index: integer): integer; virtual;
    function  GetXMLAttrPropInt64(index: integer): int64; virtual;
    function  GetXMLAttrPropReal(index: integer): real; virtual;
    function  GetXMLAttrPropTime(index: integer): TDateTime; virtual;
    function  GetXMLProp(index: integer): string; virtual;
    function  GetXMLPropBool(index: integer): boolean; virtual;
    function  GetXMLPropCardinal(index: integer): cardinal; virtual;
    function  GetXMLPropCData(index: integer): string; virtual;
    function  GetXMLPropDate(index: integer): TDateTime; virtual;
    function  GetXMLPropDateTime(index: integer): TDateTime; virtual;
    function  GetXMLPropDWORD(index: integer): DWORD; virtual;
    function  GetXMLPropInt(index: integer): integer; virtual;
    function  GetXMLPropInt64(index: integer): int64; virtual;
    function  GetXMLPropReal(index: integer): real; virtual;
    function  GetXMLPropTime(index: integer): TDateTime; virtual;
    procedure InitChildNodes(tags: array of string; defaults: array of Variant); virtual;
    procedure SetAsString(const Value: string); virtual;
    procedure SetText(const Value: string); virtual;
    procedure SetXMLAttrProp(const index: integer; const value: string); virtual;
    procedure SetXMLAttrPropBool(const index: integer; const value: boolean); virtual;
    procedure SetXMLAttrPropCardinal(const index: integer; const value: cardinal); virtual;
    procedure SetXMLAttrPropDate(const index: integer; const value: TDateTime); virtual;
    procedure SetXMLAttrPropDateTime(const index: integer; const value: TDateTime); virtual;
    procedure SetXMLAttrPropDWORD(const index: integer; const value: DWORD); virtual;
    procedure SetXMLAttrPropInt(const index: integer; const value: integer); virtual;
    procedure SetXMLAttrPropInt64(const index: integer; const value: int64); virtual;
    procedure SetXMLAttrPropReal(const index: integer; const value: real); virtual;
    procedure SetXMLAttrPropTime(const index: integer; const value: TDateTime); virtual;
    procedure SetXMLProp(const index: integer; const value: string); virtual;
    procedure SetXMLPropBool(const index: integer; const value: boolean); virtual;
    procedure SetXMLPropCardinal(const index: integer; const value: cardinal); virtual;
    procedure SetXMLPropCData(const index: integer; const value: string); virtual;
    procedure SetXMLPropDate(const index: integer; const value: TDateTime); virtual;
    procedure SetXMLPropDateTime(const index: integer; const value: TDateTime); virtual;
    procedure SetXMLPropDWORD(const index: integer; const value: DWORD); virtual;
    procedure SetXMLPropInt(const index: integer; const value: integer); virtual;
    procedure SetXMLPropInt64(const index: integer; const value: int64); virtual;
    procedure SetXMLPropReal(const index: integer; const value: real); virtual;
    procedure SetXMLPropTime(const index: integer; const value: TDateTime); virtual;
    property OwnerList: TGpXMLList read xmlList write xmlList;
  public
    constructor Create(node: IXMLNode); overload; virtual; // use this constructor in most cases
    constructor Create(nodeData: string); overload; virtual; // do other constructors need to be public?
    constructor Create(parentNode: IXMLNode; nodeTag: string); overload; virtual;
    constructor Create; overload; virtual;
    procedure Assign(dataNode: TGpXMLData);
    procedure AssignNonvolatile(dataNode: TGpXMLData);
    property  AsString: string read GetAsString write SetAsString;
    property  Node: IXMLNode read xmlNode;
    property  Text: string read GetText write SetText;
  end; { TGpXMLData }

  TGpXMLDataClass = class of TGpXMLData;

  {:Data class that is stringable but not persistent.
    @since   2003-01-06
  }
  TGpXMLVolatileData = class(TGpXMLData)
  protected
    procedure MarkVolatile; virtual;
  public
    constructor Create(node: IXMLNode); overload; override;
    constructor Create; overload; override;
  end; { TGpXMLVolatileData }

  {:Data class that is not streamable - it cannot be stored or extracted as a
    string.
    OK, that is a lie, you can do the XMLSaveToString(TGpXMLList.XMLDoc), but
    you are not supposed to.
    @since   2003-01-09
  }
  TGpXMLPrivateData = class(TGpXMLData)
  protected
    procedure MarkPrivate; virtual;
  public
    constructor Create(node: IXMLNode); overload; override;
    constructor Create; overload; override;
  end; { TGpXMLPrivateData }

  {:Base class handling list of twisty little TGpXMLData objects, all alike.
    Contains _no_ default indexed property - it should be created in derived
    classes.
  }
  TGpXMLList = class
  private
    xmlChildClass: TGpXMLDataClass;
    xmlChildTag  : string;
    xmlChildNodes: TObjectList; // of TGpXMLData
    xmlNode      : IXMLNode;
  protected
    function  CreateStandalone: TGpXMLData;
    function  Get(idx: integer): TGpXMLData;
  public
    constructor Create(parentNode: IXMLNode; nodeTag, childTag: string;
      childClass: TGpXMLDataClass); virtual;
    destructor  Destroy; override;
    function  Add: TGpXMLData; virtual;
    procedure Clear; virtual;
    function  Count: integer; virtual;
    procedure Delete(childNode: TGpXMLData); virtual;
    function  IndexOf(childNode: TGpXMLData): integer;
    property  Items[idxItem: integer]: TGpXMLData read Get;
    property  Node: IXMLNode read xmlNode;
  end; { TGpXMLList }

  {:Encapsulation of the XML document containing methods for loading and
    saving state. Derived classes will typically want to override
    RecreateChildren to create owned objects.
  }
  TGpXMLDoc = class(TGpXMLData)
  private
    xmlLastError: string;
    xmlRootTag  : string;
  protected
    function  CreatePersistentClone: IXMLDocument; virtual;
    function  GetAsString: string; override;
    function  GetXMLRoot: IXMLElement; virtual;
    procedure SetAsString(const Value: string); override;
  public
    constructor Create(rootTag: string); reintroduce;
    constructor Clone(doc: TGpXMLDoc); virtual;
    procedure CreateRootNode; virtual;
    function  LoadFromFile(const fileName: string): boolean; virtual;
{$IFDEF MSWINDOWS}
    function  LoadFromRegistry(rootKey: HKEY; const key, value: string): boolean; virtual;
    function  SaveToRegistry(rootKey: HKEY; const key, value: string; outputFormat: TOutputFormat = ofNone): boolean; virtual;
{$ENDIF}
    function  LoadFromStream(stream: TStream): boolean; virtual;
    function  LoadFromString(const dataString: string): boolean; virtual;
    procedure RecreateChildren; virtual;
    procedure Reset; virtual;
    function  SaveToFile(const fileName: string; outputFormat: TOutputFormat = ofNone): boolean; virtual;
    function  SaveToStream(stream: TStream; outputFormat: TOutputFormat = ofNone): boolean; virtual;
    function  SaveToString(var dataString: string; outputFormat: TOutputFormat = ofNone): boolean; virtual;
    property  AsString: string read GetAsString write SetAsString;
    property  LastError: string read xmlLastError;
    property  RootTag: string read xmlRootTag;
    property  XMLDoc: IXMLDocument read xmlXMLDoc;
    property  XMLRoot: IXMLElement read GetXMLRoot;
  end; { TGpXMLDoc }

  {:XML document containing only a list of nodes with the same structure.
  }
  TGpXMLDocList = class(TGpXMLDoc)
  private
    xmlChildClass: TGpXMLDataClass;
    xmlChildTag  : string;
    xmlList      : TGpXMLList;
    xmlListTag   : string;
  protected
    function  Get(idx: integer): TGpXMLData;
    function  GetNode: IXMLNode; virtual;
  public
    constructor Create(rootTag, listTag, childTag: string;
      childClass: TGpXMLDataClass); reintroduce; virtual;
    destructor  Destroy; override;
    function  Add: TGpXMLData; virtual;
    procedure Clear; virtual;
    function  Count: integer; virtual;
    procedure Delete(childNode: TGpXMLData); virtual;
    function  IndexOf(childNode: TGpXMLData): integer;
    procedure RecreateChildren; override;
    property  Items[idxItem: integer]: TGpXMLData read Get;
    property  Node: IXMLNode read GetNode;
  end; { TGpXMLDocList }

implementation

uses
  SysUtils,
{$IFDEF MSWINDOWS}
  Registry,
{$ENDIF}
  OmniXMLUtils;

resourcestring
  sXMLfileIsCorrupt = 'XML file is corrupt.';

const
  CContainsPrivateAttr  = 'ContainsPrivateNodes';
  CContainsVolatileAttr = 'ContainsVolatileNodes';
  CIsPrivateAttr        = 'Private';
  CIsVolatileAttr       = 'Volatile';

{ TGpXMLData }

{:Assign contents of another data object.
  @since   2002-12-26
}
procedure TGpXMLData.Assign(dataNode: TGpXMLData);
begin
  CopyNode(dataNode.Node, xmlNode, true);
end; { TGpXMLData.Assign }

{:Assign nonvolatile contents of another data object.
  @since   2003-01-07
}        
procedure TGpXMLData.AssignNonvolatile(dataNode: TGpXMLData);
begin
  CopyNode(dataNode.Node, xmlNode, true, FilterNodes);
end; { TGpXMLData.AssignNonvolatile }

{:Create object and remember XML node. Derived classes should inherit from this
  constructor and initialize xmlChildNodeDefaults and xmlChildNodeTags arrays.
  @param   node XML node containing object data.
}
constructor TGpXMLData.Create(node: IXMLNode);
begin
  Assert(assigned(node), 'Node is not assigned in TGpXMLData.Create');
  xmlNode := node;
end; { TGpXMLData.Create }

{:Create object in named child node. If child node doesn't exist, it will be
  created.
  @param   parentNode Parent XML node.
  @param   nodeTag    Child node tag.
}
constructor TGpXMLData.Create(parentNode: IXMLNode; nodeTag: string);
var
  myNode: IXMLNode;
begin
  myNode := EnsureNode(parentNode, nodeTag);
  Create(myNode);
end; { TGpXMLData.Create }

{:Create object in standalone mode.
}
constructor TGpXMLData.Create;
begin
  xmlXMLDoc := CreateXMLDoc;
  Create(EnsureNode(xmlXMLDoc,'_'));
end; { TGpXMLData.Create }

{:Create an object in standalone mode and load its contents from a string.
  @since   2002-12-26
}        
constructor TGpXMLData.Create(nodeData: string);
begin
  Create;
  AsString := nodeData;
end; { TGpXMLData.Create }

{:Triggered on each node during the AssignNonvolatile operation. Filters out
  volatile and private nodes.
  @since   2003-01-06
}
procedure TGpXMLData.FilterNodes(node: IXMLNode;
  var canProcess: boolean);
begin
  canProcess :=
    (not (GetNodeAttrBool(node, CIsVolatileAttr, false) or
          GetNodeAttrBool(node, CIsPrivateAttr, false)));
end; { TGpXMLData.FilterNodes }

{:Filter out private nodes during the AsString get.
  @since   2003-01-09
}        
procedure TGpXMLData.FilterPrivateNodes(node: IXMLNode;
  var canProcess: boolean);
begin
  canProcess := (not GetNodeAttrBool(node, CIsPrivateAttr, false));
end; { TGpXMLData.FilterPrivateNodes }

{:Serialize contents of an object.
  @since   2002-12-25
}
function TGpXMLData.GetAsString: string;
var
  p            : integer;
  tmpDoc       : IXMLDocument;
  xmlStandalone: TGpXMLData;
begin
  if assigned(xmlXMLDoc) then begin
    if GetNodeAttrBool(xmlXMLDoc, CContainsPrivateAttr, false) then
      tmpDoc := CloneDocument(xmlXMLDoc, FilterPrivateNodes)
    else
      tmpDoc := xmlXMLDoc;
    Result := XMLSaveToString(tmpDoc);
    Delete(Result, 1, Pos('>', Result));
    p := LastDelimiter('<', Result);
    Delete(Result, p, Length(Result)-p+1);
  end
  else if not assigned(xmlList) then