superstream.pas

C++中的STL真的让人爱不释手,如果你使用DELPHI,现在你也有了类似于STL的标准库,还不赶快下载啊!

{**
	SuperStream is copyright (c) 2000 Ross Judson.<P>

  The contents of this file are subject to the Mozilla Public License
  Version 1.0 (the "License"); you may not use this file except in
  compliance with the License. You may obtain a copy of the
  License at http://www.mozilla.org/MPL/ <P>

  SuperStream documentation is in DelphiDoc format.  For information on
  DelphiDoc, please visit www.soletta.com.  Any updates to SuperStream can
  also be found there.  <P>

  Use tab size 2. <P>

	The SuperStream brings several important new capabilities to Delphi.   <P>

  First, the TStreamAdapter class permits the construction of streams
  that alter or buffer the data that passes through them, on the way to
  another stream.  An ownership concept is present, so that the streams
  are easy to build and free.  This enables, for example, easy buffering
  of TFileStreams.  The stock TFileStream is unbuffered and rather slow
  if many small io operations are made to it.  A TBufferedStream adapter
  can be placed on top of it to improve performance.  Stream adapters can
  be chained, so a TObjStream can be placed over a TBufferedStream, which
  is over a TFileStream, and so on.  <P>

  TBufferedStreams speed up io against the underlying stream if it is slow
  for many small reads and writes.   <P>

  TObjStream permits the easy storage and recovery of complex object graphs,
  complete with versioning.  It makes use of as much information as it
  can that is provided by the Delphi compiler.  Usage of the object streams
  is as simple as declaring an "object io procedure" for a class of
  object and registering it.  TObjStream differs from most object streaming
  code in that it makes heavy use of Delphi's open arrays to make coding
  as easy as possible.  <P>

  TObjStream understands class hierarchies, so any io procedures that are
  declared for superclasses are also called.  <P>

  TObjStream is suitable for many lightweight object storage tasks.  Couple
  TObjStream objects together with TBufferedStreams to improve performance.  <P>

  Here are the steps to use an object stream: <P>

  </UL>
  <LI> Decide which classes should be persistent.</LI>
	<LI> Write IO procedures for those classes.  Each IO procedure should have
  		the following signature:
  <CODE> TObjIO = procedure(obj : TObject; stream : TObjStream; direction : TObjIODirection; version : Integer; var callSuper : Boolean); </CODE> </LI>
	<LI> Register the IO procedures by calling TObjStream.RegisterClass. </LI>
  <LI> Create an object stream then read or write to it using WriteObject or
  ReadObject. </LI>
  </UL> <P>

  Your IO procedure should be prepared to receive a version number other than
  the tip revision.  If it receives an older version, it should correctly
  load the older version of the object.  The best way to do this is to use
  case statements, switching on the object version.  When you write objects,
  you should generally write the latest version.  By doing this, your
  application can read in old objects, but will automatically upgrade them
  to the latest version.  See the TestIO routine in the sample file for
  an example of this.<P>

  If you wish to register a class for IO but don't need to provide a procedure
  for it 'cause the superclass procedure will do, you still need to call
  RegisterClass.  Pass nil in place of an IO procedure pointer.

  See the StrTestFrm.pas file for example IO procedures.  You will primarily
  be using the TransferItems and TransferItemsEx calls.  If you need to
  handle TDateTime, Single, or Double, make sure you use the TransferItemsEx
  call, passing the ssvt constants appropriate to your data.<P>

  To transfer arrays of items, use the TransferArrays calls.  <P>

  Serializing sets can be a bit tricky.  Use the TransferBlocks call to
  handle sets -- pass the address of the set and do a SizeOf() call on the
  set to find out how much data to store.   <P>

  Note that you can freely mix calls to WriteObject and the various
  transfer calls during your IO procedures.  <P>

  Here is an example IO procedure:  <P>

  <PRE><CODE>
procedure TestIO(obj : TObject; stream : TObjStream; direction : TObjIODirection; version : Integer; var callSuper : Boolean);
begin
	with obj as TTest do
  	case version of
     1:
			begin
      	// old version didn't have a t value
		  	stream.TransferItems([s], [@s], direction, version);
        t := 'yipe';
      end;
     2:
	  	stream.TransferItems([s,t], [@s, @t], direction, version);
    end;

end;
  </CODE></PRE>

}

// We violate range checking in a few places here, deliberately.
{$RANGECHECKS OFF}

{$IFDEF VER100}
{$DEFINE DELPHI3}
{$ENDIF}

{$IFDEF VER110}
{$DEFINE DELPHI3}
{$ENDIF}

{$IFDEF VER120}
{$DEFINE DELPHI4}
{$ENDIF}


unit SuperStream;

interface

uses Classes, SysUtils;

const

	// These are straight from system.pas, except we've added ssvtSingle and ssvtDouble
	// so we can handle those kind of values.
	ssvtNone = -1;

	{** Indicates that the item is a single-precision (4 byte) floating point number. }
	ssvtSingle = -2;
	{** Indicates that the item is a double-precision (8 byte) floating point number. }
	ssvtDouble = -3;
	{** Indicates that the item is a TDateTime, which is really a double. }
	ssvtDateTime = ssvtDouble;

	{** Indicate that the item is an integer (32-bit). }
	ssvtInteger    = vtInteger   ;
	{** Indicate that the item is a boolean. }
	ssvtBoolean    = vtBoolean   ;
	{** Indicate that the item is a character. }
	ssvtChar       = vtChar      ;
	{** Indicate that the item is an extended floating point value. Unless your variable
	is specifically declared as extended, you will rarely want to use this.  Instead,
	use the ssvtSingle or ssvtDouble as appropriate. }
	ssvtExtended   = vtExtended  ;
	{** Indicate that the item is a short string. }
	ssvtString     = vtString    ;
	{** Indicate that the item is a pointer. }
	ssvtPointer    = vtPointer   ;
	{** Indicate that the item is a pointer to character. }
	ssvtPChar      = vtPChar     ;
	{** Indicate that the item is an object. }
	ssvtObject     = vtObject    ;
	{** Indicate that the item is a class object. }
	ssvtClass      = vtClass     ;
	{** Indicate that the item is a wide character. }
	ssvtWideChar   = vtWideChar  ;
	{** Indicate that the item is a pointer to wide characters. }
	ssvtPWideChar  = vtPWideChar ;
	{** Indicate that the item is an AnsiString (long string). }
	ssvtAnsiString = vtAnsiString;
	{** Indicate that the item is a currency value (like extended). }
	ssvtCurrency   = vtCurrency  ;
	{** Indicate that the item is a variant (not supported). }
	ssvtVariant    = vtVariant   ;
	{** Indicate that the item is an interface (not supported). }
  ssvtInterface  = vtInterface ;
  {** Indicate that the item is a wide string (not supported). }
	ssvtWideString = vtWideString;

{$IFDEF DELPHI4}
	ssvtInt64 = vtInt64;
{$ENDIF}

type

	TInitializer = procedure;

	{** TStreamAdapter defines a stream that wraps another stream. }
  TStreamAdapter = class(TStream)

  public
  	{** Construct a stream adapter.
    	@param 	targetStream		The stream being adapted.
      @param	owned						If true, the stream being adapted will be destroyed
      												when the adapter is destroyed. }
  	constructor Create(targetStream : TStream; owned : Boolean);

    {** Destroy a stream adapter.  Will also destroy the target stream if
    the owned flag is set true. }
    destructor Destroy; override;

    {** Read count bytes into buffer.  This is an override of the standard
    stream function.
    	@param 	buffer		Variable to read bytes into.
      @param	count			Number of bytes to read. }
		function Read(var Buffer; Count: Longint): Longint; override;

    {** write count bytes to the stream.  This is an override of the standard
    stream function.
    	@param buffer Variable to write to the stream.
      @param count Number of bytes to write. }
		function Write(const Buffer; Count: Longint): Longint; override;

    {** Move to a given position in the stream.
    @param 	offset 	The position to move to.
    @param	origin	Where to move:  Can be soFromBeginning, soFromCurrent, or soFromEnd. }
		function Seek(Offset: Longint; Origin: Word): Longint; override;

	protected
  	{** The stream being adapted. }
		FStream : TStream;
    {** Indicates Whether the target stream will be freed on destruction of
    the adapter. }
		FOwned : Boolean;

		procedure SetSize(NewSize: Longint); override;

  private
  	procedure _SetSize(NewSize : LongInt);

  end;

  {** Exceptions thrown by the object streaming system will be of this class
  or a descendent. }
	TObjStreamException = class(Exception)
  end;

	TObjStream = class;

  {** This determines the whether the io is read or write. }
  TObjIODirection = (iodirRead, iodirWrite);

  {** IO procedures must have this signature. obj is the object being read or
  written.  If being written, you will probably want to case the object to
  the correct type.  If being read, the object will already have been created,
  but will NOT have had a constructor called.  If your object requires that
  a constructor be called, invoke it directly, as in obj.Create.  This will
  not create a new object, but will initialize yours.  Note that many
  constructors just initialize variables -- if you're about to read in all
  those variables, you don't need to set them beforehand.  <P>

  Stream is the object stream. You may invoke any of its methods in your
  IO procedure, including WriteObject and the TransferXXX family.   <P>

  Direction indicates whether the call is for reading (iodirRead) or writing
  (iodirWrite).  Most of the time you won't have to worry about this --
  the TransferXXX calls read and write objects automatically depending on
  the direction flag passed to them.  <P>

  Version is the version of the object.  You will always be requested to
  write only the latest version of an object, unless you specifically
  try to write an earlier version yourself.  SuperStream won't do it.  You
  may be asked to read an earlier version of an object.  You should make
  sure you correctly read the earlier version, and fill in any extra
  information that isn't covered.  That way you'll have automatic upgrading
  of your objects.  <P>

	CallSuper is a boolean that's preset to true, indicating that the superClass'
  IO procedure will be called.  If you don't want the superClass' IO procedure
  to be called, set this to false before returning.  <P>
  }
	TObjIO = procedure(obj : TObject; stream : TObjStream; direction : TObjIODirection; version : Integer; var callSuper : Boolean);

  TObjCreation = procedure(obj : TObject; stream : TObjStream; version : Integer) of object;

  TStreamRegistration = class;

  {** Each object stream starts with one of these. }
  TObjStreamHeader = record
  	magic : Integer;
    dummy1, dummy2, dummy3, dummy4 : Integer;
  end;

  {** Options that can be applied to object streams.  Currently only the
  graph option is supported.  Supplying osoGraph as an option permits the
  reading and writing of arbitrary graphs of objects.  If this option is
  not supplied, objects will be written in full each time they are
  encountered.  It is highly recommended that the osoGraph option be supplied
  if there is any chance of an object appearing more than once.  Not supplying
  the option will result in a small speedup. }
  TObjStreamOption = (
  	osoGraph // support object graphs
  );
  {** A set of stream options. }
  TObjStreamOptions = set of TObjStreamOption;

  {** Object stream adapters read and write objects from other streams. It is
  often useful to couple this adapter with a buffering adapter, as object
  streams frequently read and write with thousands of small byte count io
  operations. }
	TObjStream = class(TStreamAdapter)
  protected

  	{** Indicates whether the header has already been transferred. }
		FHeaderTransferred : Boolean;

    {** Stores the options this stream has active. }
    FOptions : TObjStreamOptions;

    {** Stores the list of objects that have been written or read.  This
		is only used in graph mode. }
    FObjList : TList;

    {** Hook for programs to modify object construction. }
    FObjCreation : TObjCreation;

  public

  	{** If assigned, this event will be fired whenever a new object is created.
    This gives the program a chance to alter the construction of the new object. }
  	property OnObjCreation : TObjCreation read FObjCreation write FObjCreation;

  	{** Register class notifies the streaming system of a persistent capable class.
    @param 	cls				The class being registered.
    @param	_writer		An io procedure for the class.
    @param	latest		The current version number for the class (an integer).
    									The version number will usually be incremented each time
                      the structure of the object changes. }
  	class procedure RegisterClass(cls : TClass; _writer : TObjIO; latest : Integer);

  	{** Register class notifies the streaming system of a persistent capable class.
    @param 	cls				The class being registered.
    @param	_writer		An io procedure for the class.
    @param	latest		The current version number for the class (an integer).
    									The version number will usually be incremented each time
                      the structure of the object changes.
    @param init				Object initializer. }
  	class procedure RegisterClassEx(cls : TClass; _writer : TObjIO; latest : Integer; init : TInitializer);

    {** Assigns default io procedures for some of Delphi's classes. If this
    is not called, io procedures will have to be registered for all classes.
    IO procedures are registered for TStringList and TObjList.  TObjList is
    a list of objects, and is contained within this unit. }
		class procedure RegisterDefaultClasses;

    {** Reads a single object from a file, very conveniently.
    @param filename  The file to read the object from. }
    class function ReadObjectInFile(const fn : String; options : TObjStreamOptions) : TObject;

    {** Writes a single object to a file, conveniently.
    @param filename The file to write the object info.
    @param obj The object to write. The object must have its class registered. }
    class procedure WriteObjectToFile(const fn : String; options : TObjStreamOptions; obj : TObject);

    {** Construct an object stream.
    @param		stream		The stream to read or write objects to/from.
    @param		owned			If true, the target stream will be freed when the object stream
    										is freed.
  	@param 		options		Options from the TobjStreamOption type.}
    constructor Create(stream : TStream; owned : Boolean; options : TObjStreamOptions);

    {** Construct an object stream on a file.  The stream will be buffered
    internally.   You must also specify whether you intend to read or write
    from the stream.
    @param fn  				The file to use for streaming.
    @param options 		Options from the TObjStreamOption type.
    @param dir 				The IO direction (iodirRead, iodirWrite). }
    constructor CreateOnFile(const fn : String; options : TObjStreamOptions; dir : TObjIODirection);

    destructor Destroy; override;

    {** Use TransferItems to load and store atomic values.  Be careful with
     floating point -- it doesn't provide a way to do single and double, yet,
     because there's no way to distinguish those types.  If you want to do
     singles, doubles, or TDateTime, use the TransferItemsEx call instead,
     which lets you specify the types of your members.

     @param		items		An array of items to read or write.  The items should be
     									encased in square brackets:  [a,b,c].  This is Delphi's
                      open array syntax.
     @param		itemAddresses  Pointers to each of the variables passed in items,
     												also in open array format:  [@a, @b, @c].
     @param		direction		Either iodirRead or iodirWrite, depending on
     											whether objects are being read or written.
     @param		version		This will contain the version number of the object
     										read in. }
    procedure TransferItems(
    	items : array of const;
      itemAddresses : array of pointer;
      direction : TObjIODirection;
      var version : Integer); virtual;

    {** TransferVarRec does the io for a single TVarRec, where that TVarRec
    is the actual storage location for the value. }
		procedure TransferVarRec(var item : TVarRec; direction : TObjIODirection);

		{** TransferItem is used to read or write a single TVarRec-based object.