acestr.pas

suite component ace report

unit AceStr;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}
uses classes;

type
  TAceStream = class(TStream)
  private
    FMemoryStream: TMemoryStream;
    FFileStream: TFileStream;
    FTempFileName: String;
    FStreamPos: LongInt;
    FStreamSize: LongInt;
    FMaxMemUsage: LongInt;
    FFileStreamSize: LongInt;
    FBufferStream: TMemoryStream;
    FBufferStart, FBufferEnd: LongInt;
  protected
    function GetFileStream: TFileStream;
    property MemoryStream: TMemoryStream read FMemoryStream write FMemoryStream;
    property FileStream: TFileStream read GetFileStream write FFileStream;
    procedure Update;
    procedure DumpToFile;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure Clear;
    property MaxMemUsage: LongInt read FMaxMemUsage write FMaxMemUsage;
  end;

var
  AceMaximumMemoryUsage: LongInt;


implementation

uses aceutil, sysutils;

constructor TAceStream.Create;
begin
  inherited Create;
  FMemoryStream := TMemoryStream.Create;
  FBufferStream := TMemoryStream.Create;
  FBufferStart := 0;
  FBufferEnd := 0;
  FStreamPos := 0;
  FStreamSize := 0;
  FFileStreamSize := 0;
  FMaxMemUsage := AceMaximumMemoryUsage;
end;

destructor TAceStream.Destroy;
begin
  Clear;
  if ( FBufferStream <> nil ) then FBufferStream.free;
  if ( FMemoryStream <> nil ) then FMemoryStream.free;
  inherited destroy;
end;

function TAceStream.GetFileStream: TFileStream;
begin
  if ( FFileStream = nil ) then
  begin
    FTempFileName := AceGetTempFile('Ace');
    FFileStream := TFileStream.Create(FTempFileName, fmCreate);
  end;
  result := FFileStream;
end;

function TAceStream.Read(var Buffer; Count: Longint): Longint;
var
  ReadIn: LongInt;
begin
  if ( FFileStream = nil ) then
  begin
    FMemoryStream.Position := FStreamPos;
    result := FMemoryStream.Read(Buffer, Count);
    FStreamPos := FMemoryStream.Position;
  end else
  begin
    if ( FStreamPos >= FFileStreamSize ) then
    begin
      FMemoryStream.Position := FStreamPos - FFileStream.Size;
      result := FMemoryStream.Read(buffer, Count);
      FStreamPos := FMemoryStream.Position + FFileStream.Size;
    end else
    begin
      if FMemoryStream.Size > 0 then DumpToFile;
      if (FBufferStream.Size = 0) or (FBufferStart > FStreamPos) or
         (FBufferEnd < (FStreamPos + Count)) then
      begin
        FBufferStream.Clear;
        FBufferStart := FStreamPos;
        ReadIn := 10000;
        if Count > ReadIn then ReadIn := Count;
        if ReadIn > (FFileStreamSize - FStreamPos) then ReadIn := (FFileStreamSize - FStreamPos);
        FBufferEnd := FStreamPos + ReadIn;
        FFileStream.Position := FStreamPos;
        FBufferStream.CopyFrom(FFileStream, ReadIn)
      end;
      FBufferStream.Position := FStreamPos-FBufferStart;
      result := FBufferStream.Read(buffer, Count);
      FStreamPos := FStreamPos + Count;
    end;
  end;

end;

function TAceStream.Write(const Buffer; Count: Longint): Longint;
begin
  Update;
  if ( FFileStream = nil ) then
  begin
    FMemoryStream.Position := FStreamPos;
    result := FMemoryStream.Write(Buffer, Count);
    FStreamPos := FMemoryStream.Position;
    FStreamSize := FMemorystream.Size;
  end else
  begin
    if ( FStreamPos >= FFileStreamSize ) then
    begin
      FMemoryStream.Position := FStreamPos - FFileStreamSize;
      result := FMemoryStream.Write(buffer, Count);
      FStreamSize := FMemoryStream.Size + FFileStreamSize;
      FStreamPos := FFileStreamSize + FMemoryStream.Position;
    end else
    begin
      DumpToFile;
      FFileStream.Position := FStreamPos;
      result := FFileStream.Write(buffer, Count);
      FStreamSize := FFileStream.Size;
      FStreamPos := FFileStream.Position;
    end;
  end;
end;

procedure TAceStream.Update;
begin
  if ( FMemoryStream.Size > FMaxMemUsage ) then
  begin
    DumpToFile;
  end;
end;

procedure TAceStream.DumpToFile;
begin
  if FMemoryStream.Size > 0 then
  begin
    FileStream.Position := FileStream.Size;
    FileStream.CopyFrom(FMemoryStream, 0); { zero means copy entire stream }
    FMemoryStream.Clear;
    FFileStreamSize := FStreamSize;
  end;
end;

function TAceStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case ( Origin ) of
    0: FStreamPos := Offset;
    1: Inc(FStreamPos, Offset);
    2: FStreamPos := FStreamSize + Offset;
  end;
  result := FStreamPos;
end;

procedure TAceStream.Clear;
begin
  FStreamPos := 0;
  FStreamSize := 0;
  FMemoryStream.Clear;
  FBufferStart := 0;
  FBufferEnd := 0;
  FBufferStream.Clear;
  if ( FFileStream <> nil  ) then
  begin
    FFileStream.free;
    sysutils.DeleteFile(FTempFileName);
    FFileStream := nil;
    FTempFileName := '';
    FFileStreamSize := 0;
  end;
end;

initialization
  AceMaximumMemoryUsage := 512000;
end.