A Binary Tree Structure "PersistentTree"

• Tweet
• 

        unit StreamAdapter.pas

//+ Jonas Raoni Soares Silva
//@ http://jsfromhell.com

unit StreamAdapter;

interface

uses
  Classes;

type
  IStream = interface( IInterface )
    ['{FBEF199A-09BC-4B61-89EA-1EF8B22C93A5}']
    function Read(var Buffer; const Count: Longint): Longint;
    function Write(const Buffer; const Count: Longint): Longint;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
    procedure ReadBuffer(var Buffer; const Count: Longint);
    procedure WriteBuffer(const Buffer; const Count: Longint);
    function CopyFrom(Source: TStream; const Count: Int64): Int64;
    function WriteTo(Dest: TStream; const Count: Int64): Int64;

    procedure SetPosition( const Value: Int64 );
    procedure SetSize( const Value: Int64 );
    function GetPosition: Int64;
    function GetSize: Int64;

    property Position: Int64 read GetPosition write SetPosition;
    property Size: Int64 read GetSize write SetSize;
  end;

  TStreamAdapter = class( TInterfacedObject, IStream )
  private
    FStream: TStream;
    procedure SetPosition( const Value: Int64 );
    procedure SetSize( const Value: Int64 );
    function GetPosition: Int64;
    function GetSize: Int64;

  public
    constructor Create( Stream: TStream );
    destructor Destroy; override;

    function Read(var Buffer; const Count: Longint): Longint;
    function Write(const Buffer; const Count: Longint): Longint;

    procedure ReadBuffer(var Buffer; const Count: Longint);
    procedure WriteBuffer(const Buffer; const Count: Longint);

    function CopyFrom(Source: TStream; const Count: Int64): Int64;
    function WriteTo(Dest: TStream; const Count: Int64): Int64;

    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;

    property Position: Int64 read GetPosition write SetPosition;
    property Size: Int64 read GetSize write SetSize;
  end;

implementation

{ TStreamAdapter }

function TStreamAdapter.CopyFrom(Source: TStream; const Count: Int64): Int64;
begin
  Result := FStream.CopyFrom( Source, Count );
end;

constructor TStreamAdapter.Create(Stream: TStream);
begin
  FStream := Stream;
end;

destructor TStreamAdapter.Destroy;
begin
  FStream.Free;
  inherited;
end;

function TStreamAdapter.GetPosition: Int64;
begin
  Result := FStream.Position;
end;

function TStreamAdapter.GetSize: Int64;
begin
  Result := FStream.Size;
end;

function TStreamAdapter.Read(var Buffer; const Count: Integer): Longint;
begin
  Result := FStream.Read( Buffer, Count );
end;

procedure TStreamAdapter.ReadBuffer(var Buffer; const Count: Integer);
begin
  FStream.ReadBuffer( Buffer, Count );
end;

function TStreamAdapter.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  Result := FStream.Seek( Offset, Origin );
end;

procedure TStreamAdapter.SetPosition(const Value: Int64);
begin
  FStream.Position := Value;
end;

procedure TStreamAdapter.SetSize(const Value: Int64);
begin
  FStream.Size := Value;
end;

function TStreamAdapter.Write(const Buffer; const Count: Integer): Longint;
begin
  Result := FStream.Write( Buffer, Count );
end;

procedure TStreamAdapter.WriteBuffer(const Buffer; const Count: Integer);
begin
  FStream.WriteBuffer( Buffer, Count );
end;

function TStreamAdapter.WriteTo(Dest: TStream; const Count: Int64): Int64;
begin
  Result := Dest.CopyFrom( FStream, Count );
end;

end.

unit PersistentTree.pas

//+ Jonas Raoni Soares Silva
//@ http://jsfromhell.com

unit PersistentTree;

interface

uses
  Windows, Classes, SysUtils, StreamAdapter;

type
  EPersistentTree = class( Exception );

  TPersistentTree = class;

  TPersistentTreeClass = class of TPersistentTree;

  TPersistentTree = class( TStream )
  private
    FStream: IStream;
    FList: TList;
    FBaseClass: TPersistentTreeClass;
    FOwner, FParent: TPersistentTree;
    FOwnStream: Boolean;
    FDataFilename, FFilename: string;
    FLastPosition, FDataBegin, FDataLength: Int64;

    function GetItem(const Index: Integer): TPersistentTree;
    function GetCount: Integer;
    function GetStream: TStream;
    function Import( Item: TPersistentTree ): Boolean;
    procedure ClearData;
    procedure RecreateStream( const Pos: Int64; const Deep: Boolean = False );
    procedure Synchronize;

  protected
    //override to provide writing/reading notifications
    procedure Loaded; virtual;
    procedure Saving; virtual;

    //derived from TStream
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); override;
    procedure SetSize(const NewSize: Int64); override;

  public
    constructor Create; virtual;
    destructor Destroy; override;

    //derived from TStream
    function Read( var Buffer; Count: Longint ): Longint; override;
    function Write( const Buffer; Count: Longint ): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;

    function Truncate: Int64;
    function ReadString: string;
    procedure WriteString( const Data: string );

    procedure Save( const AFilename: string ); overload;
    procedure Save( Stream: TStream ); overload;
    procedure Load( const AFilename: string ); overload;
    procedure Load( Stream: IStream ); overload;
    procedure Load( Stream: TStream ); overload;

    function Add: TPersistentTree; overload;
    function Add( Item: TPersistentTree ): Integer; overload;
    procedure Insert( const Index: Integer; Item: TPersistentTree);
    function IndexOf( Item: TPersistentTree ): Integer;
    function Remove( Item: TPersistentTree ): Integer;
    procedure Delete( const Index: Integer);
    function Extract( Item: TPersistentTree ): TPersistentTree;
    procedure Exchange( const IndexA, IndexB: Integer );
    procedure Move(const CurIndex, NewIndex: Integer);
    procedure Clear;

    property Items[ const Index: Integer ]: TPersistentTree read GetItem; default;
    property Count: Integer read GetCount;
    property Owner: TPersistentTree read FOwner;
    property Parent: TPersistentTree read FParent;
    property Filename: string read FFilename;
    property BaseClass: TPersistentTreeClass read FBaseClass write FBaseClass;
  end;

  TPersistentTreeHeader = packed record
    Sig: array[0..4] of Char;
    Ver: Word;
  end;

const
  PERSISTENT_TREE_HEADER: TPersistentTreeHeader = ( Sig: 'PTREE'; Ver: 1 );

function GetTempFile: string;


implementation

function GetTempFile: string;
var
  Path: array[0..MAX_PATH-1] of Char;
begin
  GetTempPath( MAX_PATH, Path );
  GetTempFileName( Path, 'BUF', 0, Path );
  Result := Path;
end;

{ TPersistentTree }

procedure TPersistentTree.Clear;
var
  I: Integer;
begin
  for I := FList.Count - 1 downto 0 do
  begin
    TPersistentTree( FList[I] ).Free;
    FList.Delete( I );
  end;
end;

constructor TPersistentTree.Create;
begin
  FBaseClass := TPersistentTreeClass( Self.ClassType );
  FList := TList.Create;
  FStream := TStreamAdapter.Create( GetStream );
  FOwnStream := True;
end;

destructor TPersistentTree.Destroy;
begin
  ClearData;
  FList.Free;
  inherited;
end;

procedure TPersistentTree.Exchange(const IndexA, IndexB: Integer);
begin
  FList.Exchange( IndexA, IndexB );
end;

function TPersistentTree.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TPersistentTree.GetItem(const Index: Integer): TPersistentTree;
begin
  Result := FList[ Index ];
end;

function TPersistentTree.IndexOf(
  Item: TPersistentTree): Integer;
begin
  Result := FList.IndexOf( Item );
end;

procedure TPersistentTree.Load(const AFilename: string);
var
  FS: TFileStream;
  //Header: TPersistentTreeHeader;
begin
  FS := TFileStream.Create( AFilename, fmOpenRead or fmShareDenyWrite );
  try
    //FS.Read( Header, SizeOf( TPersistentTreeHeader ) );
    //if not CompareMem( @Header, @PERSISTENT_TREE_HEADER, SizeOf( TPersistentTreeHeader ) ) then
    //  raise EPersistentTree.CreateFmt( '%s.LoadFromFile :: "%s" Not Recognized', [ClassName, AFilename] );
    Load( FS );
    FFilename := AFilename;
  except
    FS.Free;
    raise;
  end;
end;

procedure TPersistentTree.Load(Stream: TStream);
begin
  Load( TStreamAdapter.Create( Stream ) );
end;

function TPersistentTree.Remove(Item: TPersistentTree): Integer;
begin
  Result := FList.Remove( Item );
  if Result >= 0 then
    Item.Free;
end;

procedure TPersistentTree.Save( const AFilename: string );
var
  FS: TFileStream;
begin
  FS := TFileStream.Create( AFilename, fmCreate or fmShareDenyWrite );
  try
    //FS.Write( PERSISTENT_TREE_HEADER, SizeOf( TPersistentTreeHeader ) );
    Save( FS );
  finally
    FS.Free;
  end;
end;

procedure TPersistentTree.Save(Stream: TStream);
var
  I: LongInt;
begin
  Seek( 0, soBeginning );
  Saving;

  FDataLength := Size;
  Stream.Write( FDataLength, SizeOf( FDataLength ) );
  Stream.CopyFrom( Self, 0 );

  I := FList.Count;
  Stream.Write( I, SizeOf( I ) );
  for I := 0 to FList.Count-1 do
    Self[I].Save( Stream );
end;

function TPersistentTree.Write( const Buffer; Count: Longint ): Longint;
begin
  if FOwnStream then
    Result := FStream.Write( Buffer, Count )
  else
  begin
    Synchronize;
    if Position + Count > Size then
      RecreateStream( Position );
    Result := FStream.Write( Buffer, Count );
    FLastPosition := FStream.Position;          
  end;

end;

function TPersistentTree.Read( var Buffer; Count: Longint): Longint;
begin
  if FOwnStream then
    Result := FStream.Read( Buffer, Count )
  else
  begin
    Synchronize;
    if Count < 0 then
      Count := 0
    else if Count > Size - Position then
      Count := Size - Position;
    Result := FStream.Read( Buffer, Count );
    FLastPosition := FStream.Position;
  end
end;

function TPersistentTree.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  if FOwnStream then
    Result := FStream.Seek( Offset, Origin )
  else
  begin
    Synchronize;
    case Origin of
      soBeginning: Result := FDataBegin + Offset;
      soCurrent: Result := FStream.Position + Offset;
      soEnd: Result := FDataBegin + Size - Offset;
    else
      Result := 0;
    end;
    if Result > -1 then
      if Result <= FDataBegin + Size then
        Result := FStream.Seek( Result, soBeginning ) - FDataBegin
      else
      begin
        RecreateStream( Size );
        Result := FStream.Seek( Result, soBeginning );
      end;
    FLastPosition := FStream.Position;
  end;
end;

procedure TPersistentTree.SetSize(const NewSize: Int64);
begin
  if FOwnStream then
    FStream.Size := NewSize
  else begin
    if NewSize <= 0 then
      RecreateStream( 0 )
    else if NewSize > Size then
      RecreateStream( Size )
    else
    begin
      FDataLength := NewSize;
      Seek( 0, soEnd );
    end;
    FLastPosition := FStream.Position;
  end;
end;

procedure TPersistentTree.Synchronize;
begin
  if not FOwnStream and ( ( FStream.Position < FDataBegin ) or ( FStream.Position - FDataBegin > FDataLength ) ) then
    FStream.Seek( FLastPosition, soBeginning );
end;

procedure TPersistentTree.Load( Stream: IStream);
var
  I: LongInt;
begin
  ClearData;

  FStream := Stream;
  FOwnStream := False;

  Stream.Read( FDataLength, SizeOf( FDataLength ) );
  FDataBegin := FStream.Position;
  FLastPosition := FDataBegin;

  Stream.Seek( FDataLength, soCurrent );

  Stream.Read( I, SizeOf( I ) );
  for I := I - 1 downto 0 do
    Add.Load( FStream );

  //Seek( 0, soBeginning ); it isnt needed since synchonize will do it anyway
  Loaded;
  FStream.Seek( FDataBegin + FDataLength + SizeOf( I ), soBeginning );
end;

function TPersistentTree.Extract( Item: TPersistentTree): TPersistentTree;
begin
  Result := FList.Extract( Item );
  if Assigned( Result ) then begin
    Result.FParent := nil;
    Result.FOwner := nil;
    Result.RecreateStream( Size, True );
  end;
end;


function TPersistentTree.GetSize: Int64;
begin
  if FOwnStream then
    Result := FStream.Size
  else
    Result := FDataLength;
end;

procedure TPersistentTree.WriteString(const Data: string);
var
  I: LongWord;
begin
  I := Length( Data );
  Write( I, SizeOf( I ) );
  Write( Pointer( Data )^, I );
end;

function TPersistentTree.ReadString: string;
var
  I: LongWord;
begin
  Read( I, SizeOf( I ) );
  SetLength( Result, I );
  Read( Pointer( Result )^, I );
end;

procedure TPersistentTree.SetSize(NewSize: Integer);
begin
  SetSize( Int64( NewSize ) );
end;

procedure TPersistentTree.RecreateStream( const Pos: Int64; const Deep: Boolean );
var
  FS: TStream;
  I: Integer;
begin
  if not FOwnStream then
  begin
    FS := GetStream;
    if Pos > 0 then
    begin
      Seek( 0, soBeginning );
      FS.CopyFrom( Self, Pos );
    end;
    FStream := TStreamAdapter.Create( FS );
    FOwnStream := True;
  end;
  if Deep then
    for I := 0 to FList.Count - 1 do
      Self[I].RecreateStream( Self[I].Size, True );
end;

procedure TPersistentTree.ClearData;
begin
  FStream := nil;
  if FOwnStream then
    DeleteFile( FDataFilename );
  Clear;
end;

function TPersistentTree.GetStream: TStream;
begin
  FDataFilename := GetTempFile;
  Result := TFileStream.Create( FDataFilename, fmCreate or fmShareDenyWrite );
end;

function TPersistentTree.Add: TPersistentTree;
begin
  Result := TPersistentTreeClass( FBaseClass ).Create;
  Add( Result );
end;

function TPersistentTree.Add( Item: TPersistentTree): Integer;
begin
  if Import( Item ) then
    Result := FList.Add( Item )
  else
    Result := FList.IndexOf( Item );
end;

procedure TPersistentTree.Delete(const Index: Integer);
begin
  TPersistentTree( FList[Index] ).Free;
  FList.Delete( Index );
end;

procedure TPersistentTree.Insert(const Index: Integer; Item: TPersistentTree);
begin
  if Import( Item ) then
    FList.Insert( Index, Item )
  else
    FList.Move( FList.IndexOf( Item ), Index );
end;

procedure TPersistentTree.Move(const CurIndex, NewIndex: Integer);
begin
  FList.Move( CurIndex, NewIndex );
end;

function TPersistentTree.Truncate: Int64;
begin
  Result := Position;
  Size := Result;
end;

function TPersistentTree.Import(Item: TPersistentTree): Boolean;
begin
  Result := not Assigned( Item.FParent ) or ( ( Item.FParent <> Self ) and Assigned( Item.FParent.Extract( Item ) ) );
  if Result then
  begin
    Item.FParent := Self;
    if FOwner <> nil then
      Item.FOwner := FOwner
    else
      Item.FOwner := Self;
  end;
end;

procedure TPersistentTree.Saving;
begin
//override to provide extra save features
end;

procedure TPersistentTree.Loaded;
begin
//override to provide extra load features
end;

end.

Tags:
• binary
• Data
• Delphi
• JOnAS
• jsfromhell
• Pascal
• persistent
• raoni
• structure
• Tree

Comments

Snippets Manager replied on Mon, 2012/05/07 - 2:12pm

This class is a TStream descendant with interfaced memory freeing. Well, to access data, you do the same way you would with a normal stream, read, write, etc. Basically the unique difference is that it has an items property where you can add more TPersistentTree's to it. When loading the structure from a file/stream/etc there's very few consumption, since it's lazy-load based. But when saving, it's heavy, since it runs through the tree and saves each item. I could implement a way to just record pieces that changed and also use the lost space for pieces that just decreased size, but this was enough for me, since most of my data was read-only.

• Login or register to post comments

Snippets Manager replied on Fri, 2008/01/18 - 9:41am

Is there an example of this persistant tree units?

• Login or register to post comments