{ *************************************************************************** }
{                                                                             }
{ Delphi and Kylix Cross-Platform Visual Component Library                    }
{                                                                             }
{ Copyright (c) 1995-2004 Borland Software Corporation                        }
{ Shorted by Andru 'aka' Kemka Andrey                                         }
{                                                                             }
{ *************************************************************************** }
unit minClasses;

{$I DEFINES.pas}

interface
uses
  Windows,

  minFile,
  ENGINE_UTILS;

type
{ TStream seek origins }
  TSeekOrigin = ( soBeginning, soCurrent, soEnd );

{ TStream abstract class }

  TStream = class( TObject )
  private
    function  GetPosition : Int64;
    procedure SetPosition( const Pos : Int64 );
    procedure SetSize64  ( const NewSize : Int64 );

  protected
    function  GetSize : Int64;                  virtual;
    procedure SetSize( const NewSize : Int64 ); virtual;

  public
    function  Read      ( var Buffer; Count : Longint ) : Longint; virtual; abstract;

    function  Write      ( const Buffer; Count : Longint ) : Longint; virtual; abstract;

    function Seek(       Offset : Longint; Origin : Word        ) : Longint; overload; virtual;
    function Seek( const Offset : Int64;   Origin : TSeekOrigin ) : Int64;   overload; virtual;

    function CopyFrom( Source : TStream; Count : Int64 ) : Int64;

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

{ THandleStream class }

  THandleStream = class( TStream )
  protected
    FHandle : Integer;
    procedure SetSize( const NewSize : Int64 ); override;
  public
    constructor Create( AHandle : Integer );

    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;

    property Handle : Integer read FHandle;
  end;

{ TFileStream class }

  TFileStream = class( THandleStream )
  public
    constructor Create( const FileName : string; Mode : Word );                    overload;
    constructor Create( const FileName : string; Mode : Word; Rights : Cardinal ); overload;
    destructor Destroy; override;
  end;

{ TCustomMemoryStream abstract class }

  TCustomMemoryStream = class(TStream)
  private
    FMemory: Pointer;
    FSize, FPosition: Longint;
  protected
    procedure SetPointer(Ptr: Pointer; Size: Longint);
  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    property Memory: Pointer read FMemory;
  end;

{ TMemoryStream }

  TMemoryStream = class(TCustomMemoryStream)
  private
    FCapacity: Longint;
    procedure SetCapacity(NewCapacity: Longint);
  protected
    function Realloc(var NewCapacity: Longint): Pointer; virtual;
    property Capacity: Longint read FCapacity write SetCapacity;
  public
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SetSize(const NewSize: Int64); override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

const
{ TFileStream create mode }

  fmCreate = $FFFF;

{ TStream seek origins }

  soFromBeginning = 0;
  soFromCurrent = 1;
  soFromEnd = 2;

implementation

{ TStream }

function TStream.GetPosition;
begin
  Result := Seek(0, soCurrent);
end;

procedure TStream.SetPosition;
begin
  Seek(Pos, soBeginning);
end;

function TStream.GetSize;
var
  Pos: Int64;
begin
  Pos := Seek(0, soCurrent);
  Result := Seek(0, soEnd);
  Seek(Pos, soBeginning);
end;

procedure TStream.SetSize64(const NewSize: Int64);
begin
  SetSize(NewSize);
end;

procedure TStream.SetSize;
begin
if ( NewSize < Low( Longint ) ) or ( NewSize > High( Longint ) ) Then E_Error( 'Range check error' );
SetSize(Longint(NewSize));
end;

function TStream.Seek(Offset: Longint; Origin: Word): Longint;
type
  TSeek64 = function (const Offset: Int64; Origin: TSeekOrigin): Int64 of object;
var
  Impl: TSeek64;
  Base: TSeek64;
  ClassTStream: TClass;
begin
Impl := Seek;
ClassTStream := Self.ClassType;
while (ClassTStream <> nil) and (ClassTStream <> TStream) do
  ClassTStream := ClassTStream.ClassParent;
if ClassTStream = nil Then E_Error( 'Seek not implemented' );
Base := TStream(@ClassTStream).Seek;
if TMethod(Impl).Code = TMethod(Base).Code Then E_Error( 'Seek not implemented' );
Result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;

function TStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
if ( Offset < Low(Longint ) ) or ( Offset > High( Longint ) ) Then E_Error( 'Range check error' );
Result := Seek(Longint(Offset), Ord(Origin));
end;

function TStream.CopyFrom;
const
  MaxBufSize = $F000;
var
  BufSize, N: Integer;
  Buffer: PChar;
begin
  if Count = 0 then
  begin
    Source.Position := 0;
    Count := Source.Size;
  end;
  Result := Count;
  if Count > MaxBufSize then BufSize := MaxBufSize else BufSize := Count;
  GetMem(Buffer, BufSize);
  try
    while Count <> 0 do
    begin
      if Count > BufSize then N := BufSize else N := Count;
      Source.Read(Buffer^, N);
      Write(Buffer^, N);
      Dec(Count, N);
    end;
  finally
    FreeMem(Buffer, BufSize);
  end;
end;

{ THandleStream }

constructor THandleStream.Create;
begin
  inherited Create;
  FHandle := AHandle;
end;

function THandleStream.Read;
begin
  Result := FileRead(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

function THandleStream.Write;
begin
  Result := FileWrite(FHandle, Buffer, Count);
  if Result = -1 then Result := 0;
end;

function THandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result := FileSeek(FHandle, Offset, Ord(Origin));
end;

procedure THandleStream.SetSize;
begin
  Seek(NewSize, soBeginning);
  SetEndOfFile(FHandle);
end;

{ TFileStream }

constructor TFileStream.Create(const FileName: string; Mode: Word);
begin
  Create(Filename, Mode, 0);
end;

constructor TFileStream.Create(const FileName: string; Mode: Word; Rights: Cardinal);
begin
  if Mode = fmCreate then
  begin
    inherited Create(FileCreate(PChar(FileName), Rights));
//    if FHandle < 0 Then E_Error( 'Cannot create file: ' + FileName );
  end
  else
  begin
    inherited Create(FileOpen(PChar(FileName), Mode));
//    if FHandle < 0 then E_Error( 'Cannot open file: ' + FileName );;
  end;
end;

destructor TFileStream.Destroy;
begin
  if FHandle >= 0 then FileClose(FHandle);
  inherited Destroy;
end;

{ TCustomMemoryStream }

procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; Size: Longint);
begin
  FMemory := Ptr;
  FSize := Size;
end;

function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
  if (FPosition >= 0) and (Count >= 0) then
  begin
    Result := FSize - FPosition;
    if Result > 0 then
    begin
      if Result > Count then Result := Count;
      Move(Pointer(Longint(FMemory) + FPosition)^, Buffer, Result);
      Inc(FPosition, Result);
      Exit;
    end;
  end;
  Result := 0;
end;

function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: FPosition := Offset;
    soFromCurrent: Inc(FPosition, Offset);
    soFromEnd: FPosition := FSize + Offset;
  end;
  Result := FPosition;
end;

procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
begin
  if FSize <> 0 then Stream.Write(FMemory^, FSize);
end;

procedure TCustomMemoryStream.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

{ TMemoryStream }

const
  MemoryDelta = $2000; { Must be a power of 2 }

destructor TMemoryStream.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TMemoryStream.Clear;
begin
  SetCapacity(0);
  FSize := 0;
  FPosition := 0;
end;

procedure TMemoryStream.LoadFromStream(Stream: TStream);
var
  Count: Longint;
begin
  Stream.Position := 0;
  Count := Stream.Size;
  SetSize(Count);
  if Count <> 0 then Stream.Read(FMemory^, Count);
end;

procedure TMemoryStream.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
begin
  SetPointer(Realloc(NewCapacity), FSize);
  FCapacity := NewCapacity;
end;

procedure TMemoryStream.SetSize(const NewSize: Int64);
var
  OldPosition: Longint;
begin
  OldPosition := FPosition;
  SetCapacity(NewSize);
  FSize := NewSize;
  if OldPosition > NewSize then Seek(0, soFromEnd);
end;

function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
var
 HeapAllocFlags : Word;
begin
HeapAllocFlags := 2;
  if (NewCapacity > 0) and (NewCapacity <> FSize) then
    NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
  Result := Memory;
  if NewCapacity <> FCapacity then
  begin
    if NewCapacity = 0 then
    begin
      GlobalFreePtr(Memory);
      Result := nil;
    end else
    begin
      if Capacity = 0 then
        Result := GlobalAllocPtr(HeapAllocFlags, NewCapacity)
      else
        Result := GlobalReallocPtr(Memory, NewCapacity, HeapAllocFlags);
//      if Result = nil then E_Error( 'Out of memory while expanding memory stream' );
    end;
  end;
end;

function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
var
  Pos: Longint;
begin
  if (FPosition >= 0) and (Count >= 0) then
  begin
    Pos := FPosition + Count;
    if Pos > 0 then
    begin
      if Pos > FSize then
      begin
        if Pos > FCapacity then
          SetCapacity(Pos);
        FSize := Pos;
      end;
      System.Move(Buffer, Pointer(Longint(FMemory) + FPosition)^, Count);
      FPosition := Pos;
      Result := Count;
      Exit;
    end;
  end;
  Result := 0;
end;

end.
