{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  24197: IdBuffer.pas
{
{   Rev 1.20    22/11/2003 10:35:04 PM  GGrieve
{ Reverse copy direction in TIdBuffer.ExtractToStream
}
{
{   Rev 1.19    2003.10.24 10:44:54 AM  czhower
{ IdStream implementation, bug fixes.
}
{
    Rev 1.18    10/15/2003 1:03:40 PM  DSiders
  Created resource strings for TIdBuffer.Find exceptions.
}
{
{   Rev 1.17    2003.10.14 1:27:06 PM  czhower
{ Uupdates + Intercept support
}
{
{   Rev 1.16    2003.10.11 5:47:00 PM  czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{   Rev 1.15    10/5/2003 10:24:20 PM  BGooijen
{ Changed WriteBytes(var ...) to WriteBytes(const ...)
}
{
{   Rev 1.14    10/3/2003 10:46:38 PM  BGooijen
{ Fixed Range Check Exception, and fixed ExtractToStream
}
{
{   Rev 1.13    2003.10.02 8:29:12 PM  czhower
{ Changed names of byte conversion routines to be more readily understood and
{ not to conflict with already in use ones.
}
{
{   Rev 1.12    2003.10.02 12:44:58 PM  czhower
{ Comment added
}
{
{   Rev 1.11    10/2/2003 5:23:14 PM  GGrieve
{ make Bytes a public property
}
{
{   Rev 1.10    10/2/2003 5:00:38 PM  GGrieve
{ Fix bug in find - can't find last char
}
{
{   Rev 1.9    2003.10.02 10:37:00 AM  czhower
{ Comments
}
{
{   Rev 1.8    10/2/2003 3:54:06 PM  GGrieve
{ Finish cleaning up - no $IFDEFs but still optimal on both win32 and DontNet
}
{
{   Rev 1.7    10/1/2003 10:58:38 PM  BGooijen
{ Removed unused var
}
{
{   Rev 1.6    10/1/2003 8:15:58 PM  BGooijen
{ Fixed Range Check Error on D7
}
{
{   Rev 1.5    10/1/2003 8:02:22 PM  BGooijen
{ Removed some ifdefs and improved code
}
{
{   Rev 1.4    10/1/2003 10:49:02 PM  GGrieve
{ Rework buffer for Octane Compability
}
{
{   Rev 1.3    2003.10.01 2:30:44 PM  czhower
{ .Net
}
{
{   Rev 1.2    2003.10.01 1:37:32 AM  czhower
{ .Net
}
{
{   Rev 1.1    2003.10.01 1:12:32 AM  czhower
{ .Net
}
{
{   Rev 1.0    2003.09.30 10:33:56 PM  czhower
{ Readd after accidental delete.
}
{
{   Rev 1.14    2003.09.30 10:33:16 PM  czhower
{ Updates
}
{
{   Rev 1.13    2003.07.16 5:05:06 PM  czhower
{ Phase 1 of IdBuffer changes for compat.
}
{
    Rev 1.12    6/29/2003 10:56:22 PM  BGooijen
  Removed .Memory from the buffer, and added some extra methods
}
{
{   Rev 1.11    2003.06.25 4:29:06 PM  czhower
{ Free --> FreeAndNil
}
{
{   Rev 1.10    2003.01.17 2:18:36 PM  czhower
}
{
{   Rev 1.9    12-14-2002 22:08:24  BGooijen
{ Changed FMemory to FMemory.Memory in some places
}
{
{   Rev 1.8    12-14-2002 22:02:34  BGooijen
{ changed Memory to FMemory in some places, to remove some issues
}
{
{   Rev 1.7    12/11/2002 04:27:02 AM  JPMugaas
{ Fixed compiler warning.
}
{
{   Rev 1.6    12/11/2002 03:53:44 AM  JPMugaas
{ Merged the buffer classes.
}
{
{   Rev 1.5    2002.12.07 12:26:18 AM  czhower
}
{
{   Rev 1.4    12-6-2002 20:34:06  BGooijen
{ Now compiles on Delphi 5
}
{
{   Rev 1.3    6/12/2002 11:00:14 AM  SGrobety
}
{
{   Rev 1.2    12/5/2002 02:55:44 PM  JPMugaas
{ Added AddStream method for reading a stream into the buffer class.
}
{
{   Rev 1.1    23.11.2002 12:59:48  JBerg
{ fixed packbuffer
}
{
{   Rev 1.0    11/13/2002 08:38:32 AM  JPMugaas
}
unit IdBuffer;

{
.Net forces us to perform copies from strings to Bytes so that it can do the
proper unicode and other conversions.

IdBuffer is for storing data we cannot deal with right now and we do not know
the size. It must be optimized for adding to the end, and extracting from the
beginning. First pass we are just making it work, later using bubbling we will
optimize it for such tasks.

The copy is a separate issue and we considered several options. For .net we will
always have to copy data to send or to receive to translate it to binary. For
example if we have a string it must be converted to bytes. This conversion
requires a copy. All strings are WideString and must be converted to single
bytes by a convertor. This is not limited to strings.

In VCL previously all strings were AnsiString so we used a pointer and just
accessed the memory directly from the string. This avoided the overhead of a
copy.

We have come up with several ideas on how to allow the copy on .net, while
avoiding the copy on VCL to keep the performance benefit. However we must do
it in a single source manner and in a manner that does not impact the code
negatively.

For now for VCL we also do a copy. This has the advantage that Byte arrays are
reference counted and automaticaly handled by Delphi. For example:

WriteBytes(StringToBytes(s));

The array returned by this function will automatically be freed by Delphi.

There are other options that are nearly as transparent but have the additional
overhead of requiring class creation. These classes can be used to copy for .net
and proxy on VCL. It all works very nice and has low memory overhead. The
objects can then be freed by default in methods that accept them.

However after analysis, copy on VCL may not be that bad after all. The copy
only really impacts strings. The overhead to copy strings is minimal and only
used in commands etc. The big transfers come from files, streams, or other.
Such transfers have to be mapped into memory in VCL anyways, and if we map
directly into the byte array instead of the previous classes peformance should
be fine.

In short - copy under VCL should be acceptable if we watch for bottlenecks and
fix them appropriately without having to creat proxy classes. The only problem
remains for transmitting large memory blocks. But if this is done against a
fixed copy buffer the performance hit will be neglible and it is not a common
task to transmit large memory blocks.

For such transfers from streams, etc the user can declare a persistent array
of bytes that is not freed between each call to WriteBytes.

-Kudzu
}

{$I IdCompilerDefines.inc}

interface

uses
  Classes,
  IdCoreGlobal, IdException, IdStream;

const
  IdInBufCacheSizeDefault = 32 * 1024; //TIdBuffer.PackReadedSize

type
  EIdNotEnoughDataInBuffer = class(EIdException);
  EIdTooMuchDataInBuffer = class(EIdException); // only 2GB is allowed -

  TIdBufferBytesRemoved = procedure(ASender: TObject; ABytes: Integer) of object;

  // TIdBuffer is used as an internal buffer to isolate Indy from pointers and
  // memory allocations. It also allows optimizations to be kept in a single place.
  //
  // TIdBuffer is primarily used as a read/write buffer for the communication layer.

  TIdBuffer = class(TObject)
  protected
    FBytes : TIdBytes;
    FOnBytesRemoved: TIdBufferBytesRemoved;
    //
    procedure CheckAdd(AByteCount : Integer);
    procedure CheckByteCount(var VByteCount : Integer);
    function GetSize: Integer;
  public
    //
    procedure Clear;  //also clear "Readed"
    constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil); reintroduce;
    destructor Destroy; override;

    property Bytes : TIdBytes read FBytes;

    // will extract number of bytes and treat as AnsiString though WideString will be returned in DotNet
    function Extract(AByteCount: Integer = -1): string;

    // all 3 extract routines append to existing data, if any
    procedure ExtractToStream(AStream: TIdStream; AByteCount: Integer = -1);
    procedure ExtractToIdBuffer(ABuffer: TIdBuffer; AByteCount: Integer = -1);
    procedure ExtractToBytes(var VBytes: TIdBytes; AByteCount: Integer = -1);

    // note: 1 based index.
    function Find(
      const ABytes: TIdBytes;
      const AStartPos: Integer = 1
      ): Integer;
      overload;
    function Find(
      const AString: string;
      const AStartPos: Integer = 1
      ): Integer;
      overload;

    procedure Remove(const AByteCount: integer);
    // Write
    procedure Write(
      AString : string
      ); overload;
    procedure Write(
      const ABytes: TIdBytes
      ); overload;
    procedure Write(
      AStream: TIdStream;
      AByteCount: Integer = 0
      ); overload;
    //
    property Size: Integer read GetSize;
  end;

implementation

uses
  IdCoreResourceStrings,
  SysUtils;

{ TIdBuffer }

procedure TIdBuffer.CheckAdd(AByteCount : Integer);
begin
  if MAXINT - AByteCount < Length(FBytes) then
    begin
    raise EIdTooMuchDataInBuffer.create(RSTooMuchDataInBuffer);
    end;
end;

procedure TIdBuffer.CheckByteCount(Var VByteCount : Integer);
var
  LSize : Integer;
begin
  LSize := Length(FBytes);
  if VByteCount = -1 then begin
    VByteCount := LSize;
  end else begin
    if VByteCount > LSize then begin
      raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer+' ('+inttostr(VByteCount)+'/'+inttostr(LSize)+')');
    end;
  end;
end;

procedure TIdBuffer.Clear;
begin
  SetLength(FBytes, 0);
end;

constructor TIdBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
begin
  inherited Create;
  FOnBytesRemoved := AOnBytesRemoved;
  Clear;
end;

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

function TIdBuffer.Extract(AByteCount: Integer): string;
var
  LBytes : TIdBytes;
begin
  ExtractToBytes(LBytes, AByteCount);
  Result := BytesToString(LBytes);
end;

procedure TIdBuffer.ExtractToBytes(var VBytes: TIdBytes; AByteCount: Integer);
var
  LOldSize : Integer;
begin
  if AByteCount>0 then begin
    CheckByteCount(AByteCount);
    LOldSize := Length(VBytes);
    SetLength(VBytes, LOldSize + AByteCount);
    CopyTIdBytes(FBytes,0,VBytes,LOldSize,AByteCount);
    Remove(AByteCount);
  end;
end;

procedure TIdBuffer.ExtractToIdBuffer(ABuffer: TIdBuffer; AByteCount: Integer);
var
  LOldSize : integer;
begin
  CheckByteCount(AByteCount);
  LOldSize := Length(ABuffer.FBytes);
  SetLength(ABuffer.FBytes, LOldSize + AByteCount);
  CopyTIdBytes(FBytes,0,ABuffer.FBytes,LOldSize,AByteCount);
  Remove(AByteCount);
end;

procedure TIdBuffer.ExtractToStream(AStream: TIdStream; AByteCount: Integer);
begin
  CheckByteCount(AByteCount);
  AStream.Write(FBytes, AByteCount);
  Remove(AByteCount);
end;

function TIdBuffer.GetSize: Integer;
begin
  result := Length(FBytes);
end;

procedure TIdBuffer.Remove(const AByteCount: integer);
begin
  if AByteCount = Length(FBytes) then begin
    SetLength(FBytes, 0);
  end else begin
    CopyTIdBytes(FBytes,AByteCount,FBytes,0,Length(FBytes) - AByteCount);
    SetLength(FBytes, length(FBytes) - AByteCount);
  end;
end;

procedure TIdBuffer.Write(const ABytes: TIdBytes);
var
  LOldSize : Integer;
begin
  CheckAdd(length(ABytes));

  LOldSize := Length(FBytes);
  if LOldSize = 0 then begin
    FBytes := ABytes;
  end else begin
    SetLength(FBytes, LOldSize + Length(ABytes));
    CopyTIdBytes(ABytes,0,FBytes,LOldSize,Length(ABytes));
  end;
end;

procedure TIdBuffer.Write(
  AStream: TIdStream;
  AByteCount: Integer
  );
var
  LAdded : Integer;
  LOldSize : Integer;
begin
  if AByteCount = -1 then begin
    // Copy remaining
    LAdded := AStream.Stream.Size - AStream.Stream.Position;
  end else if AByteCount = 0 then begin
    // Copy all
    AStream.Stream.Position := 0;
    LAdded := AStream.Stream.Size;
  end else begin
    LAdded := Min(AByteCount, AStream.Stream.Size - AStream.Stream.Position);
  end;

  if LAdded > 0 then begin
    LOldSize := Length(FBytes);
    CheckAdd(LAdded);
    SetLength(FBytes, LOldSize + LAdded);
    AStream.ReadBytes(FBytes, LOldSize, LAdded);
  end;
end;

function TIdBuffer.Find(const AString: string; const AStartPos: Integer): Integer;
begin
  Result := Find(ToBytes(AString), AStartPos);
end;

function TIdBuffer.Find(const ABytes: TIdBytes; const AStartPos: Integer): Integer;
var
  i : integer;
  j : integer;
  LFound : boolean;
begin
  Result := 0;
  // Dont search if it empty
  if Length(FBytes) > 0 then begin
    EIdException.IfTrue(Length(ABytes) = 0, RSBufferMissingTerminator);
    EIdException.IfNotInRange(AStartPos, 1, Length(FBytes), RSBufferInvalidStartPos);

    i := AStartPos - 1;
    while (result = 0) and (i <= Length(FBytes) - Length(ABytes)) do begin
      LFound := true;
      for j := 0 to Length(ABytes) - 1 do begin
        if (i+j < Length(FBytes)) and (FBytes[i+j] <> ABytes[j]) then begin
          LFound := false;
          Break;
        end;
      end;
      if LFound then begin
        result := i + 1;
      end;
      inc(i);
    end;
  end;
end;

procedure TIdBuffer.Write(AString: String);
var
  LBytes : TIdBytes;
begin
  LBytes := ToBytes(AString);
  Write(LBytes);
end;

                                                               

(*
Test used - these should pass in both Octane and Delphi 5-7

program x;

{$APPTYPE CONSOLE}
{$I IDCompilerDefines.inc}

uses
  IdBuffer,
  IdCoreGlobal,
  Classes,
  SysUtils;

var
  GBuffer : TIdBuffer;

procedure Check(ACond : boolean);
begin
  if not ACond then
    begin
    raise exception.create('failed');
    end;
end;

const
  TEST_STR1 = 'sdfsdfsdfjhfsdajfsdhjsafdjfskfssadf';

procedure TestString;
begin
  Check(GBuffer.Size = 0);
  GBuffer.Write(TEST_STR1);
  Check(GBuffer.Size = length(TEST_STR1));
  check(GBuffer.Extract = TEST_STR1);
  check(GBuffer.size = 0);
  GBuffer.Write(TEST_STR1);
  GBuffer.Write(TEST_STR1);
  Check(GBuffer.Size = length(TEST_STR1) * 2);
  check(GBuffer.Extract(length(TEST_STR1)) = TEST_STR1);
  check(GBuffer.Extract = TEST_STR1);
  check(GBuffer.size = 0);
end;

procedure TestBytes;
var
  LBytes : TBytes;
  i : integer;
begin
  Check(GBuffer.Size = 0);
  SetLength(LBytes, 254);
  for i := 0 to 253 do
    begin
    LBytes[i] := i;
    end;
  GBuffer.WriteBytes(LBytes);
  Check(GBuffer.Size = 254);
  Check(GBuffer.Find(#1, 1) = 2);
  Check(GBuffer.Find(#1, 3) = 0);
  Check(GBuffer.Find(#3, 1) = 4);
  Check(GBuffer.Find('abc', 1) > 0);
  Check(GBuffer.Find('abd', 1) = 0);
  SetLength(LBytes,1);
  LBytes[0] := 1;
  GBuffer.ExtractToBytes(LBytes, 200);
  for i := 0 to 200 do
    begin
    if i = 0 then
      check(LBytes[i] = 1)
    else
      check(LBytes[i] = i-1);
    end;
  Check(GBuffer.Size = 54);
  GBuffer.Clear;
  check(GBuffer.size = 0);
end;

procedure TestStream;
var
  LStream : TMemoryStream;
begin
  Check(GBuffer.Size = 0);
  LStream := TMemoryStream.create;
  try
    {$IFDEF DOTNET}
    LStream.Write(BytesOf(Test_STR1), length(Test_STR1));
    {$ELSE}
    LStream.Write(TEST_STR1, length(TEST_STR1));
    {$ENDIF}
    GBuffer.WriteStream(LStream, 1);
    Check(GBuffer.Size = 0);
    GBuffer.WriteStream(LStream, 0);
    Check(GBuffer.Size = length(TEST_STR1));
    LStream.Position := LStream.Size;
    GBuffer.ExtractToStream(LStream, 10);
    Check(GBuffer.Size = length(TEST_STR1)-10);
    Check(LStream.Size = length(TEST_STR1)+10);
  finally
    FreeAndNil(LStream);
  end;
end;

procedure RunTests;
begin
  GBuffer := TIdBuffer.create;
  try
    TestString;
    TestBytes;
    TestStream;
  finally
    FreeAndNil(GBuffer);
  end;
end;

begin
  RunTests;
end.
*)

end.


