Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

About this user

Jonas Raoni Soares Silva http://jsfromhell.com

« Newer Snippets
Older Snippets »
Showing 1-1 of 1 total  RSS 

a binary tree structure "PersistentTree"

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.
to data binary pascal delphi persistent tree structure jonas jsfromhell raoni by jonasraoni on Jul 01, 2005 2 Comments
« Newer Snippets
Older Snippets »
Showing 1-1 of 1 total  RSS