{ $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:  11994: IdStream.pas
{
{   Rev 1.16    25/11/2003 12:24:22 PM  SGrobety
{ various IdStream fixes with ReadLn/D6
}
{
{   Rev 1.15    22/11/2003 12:03:50 AM  GGrieve
{ Fix offset but reading bytes
}
{
{   Rev 1.14    10/26/2003 10:09:24 PM  BGooijen
{ Compiles in DotNet
}
{
    Rev 1.13    10/24/2003 4:22:42 PM  DSiders
  Added RSStreamNotEnoughBytes for exception during stream read.
}
{
{   Rev 1.12    2003.10.24 10:44:52 AM  czhower
{ IdStream implementation, bug fixes.
}
{
{   Rev 1.11    10/21/2003 9:02:38 PM  BGooijen
{ Fixed some methods, compiles in DotNet now
}
{
{   Rev 1.10    2003.10.17 6:15:38 PM  czhower
{ Partial port
}
{
    Rev 1.9    10/15/2003 10:43:10 PM  DSiders
  Added resource strings for exceptions raised in TIdStream and TIdStream.
}
{
{   Rev 1.8    10/11/2003 4:39:28 PM  BGooijen
{ Works in d.net now too
}
{
{   Rev 1.6    9/10/2003 6:19:48 PM  SGrobety
{ removed circular call
}
{
{   Rev 1.4    10/8/2003 9:58:32 PM  GGrieve
{ fix reference to TIdStackBasdBase
}
{
{   Rev 1.3    7/10/2003 6:07:58 PM  SGrobety
{ .net
}
{
{   Rev 1.2    2003.09.30 1:23:06 PM  czhower
{ Stack split for DotNet
}
{
{   Rev 1.1    07/08/2003 01:00:46  CCostelloe
{ Function ReadLnSplit added
}
{
{   Rev 1.0    11/13/2002 08:59:50 AM  JPMugaas
2002-04-10 -Andrew P.Rybin
  -Read*, Write*, ReadLn optimization (for many strings use TIdReadLineStreamProxy)
2002-04-16 -Andrew P.Rybin
  -TIdStreamSafe, TIdStreamLight, TIdReadLineStreamProxy, optimization, misc
}
unit IdStream;

{
Note:
IFDEFs allowed here becuase of necessary differences in calls to TStream
}

{$I IdCompilerDefines.inc}

interface

uses
  Classes,
  IdException, IdCoreGlobal;

type
  EIdEndOfStream = class(EIdException);

  TIdStream = class(TObject)
    FFreeStream: Boolean;
    FStream: TStream;
  public
                             
    class function  ReadLn(AStream:TStream; AMaxLineLength: Integer = -1; AExceptionIfEOF: Boolean = FALSE): String;
    {CC: Added for retrieving lines over 16K long}
    class function  ReadLnSplit(AStream:TStream; var AWasSplit: Boolean; AMaxLineLength: Integer = -1; AExceptionIfEOF: Boolean = FALSE): String;
    class function  FindEOL(ABuf: AnsiString; var VLineBufSize: Integer; var VCrEncountered: Boolean): Integer;{Ret: StringSize}
    //
    constructor Create(
      AStream: TStream;
      AFreeStream: Boolean = False
      ); reintroduce; virtual;
    destructor Destroy;
      override;
    function ReadBytes(
      var ABytes: TIdBytes;
      ACount: Integer;
      AOffset: Integer = 0;
      AExceptionOnCountDiffer: Boolean = True
      ): Integer;
    function ReadInteger: Integer;
    function ReadString: string;
    procedure Write(AValue: string); overload;
    procedure Write(
      ABytes: TIdBytes;
      ACount: Integer = -1
      ); overload;
    procedure Write(AValue: Integer); overload;
    procedure WriteLn(AData: string = ''); overload;
    procedure WriteLn(AData: string; AArgs: array of const); overload;

    function BOF: Boolean;
    function EOF: Boolean;
    procedure Skip(ASize: Integer);
    //
    property FreeStream: Boolean read FFreeStream write FFreeStream;
    property Stream: TStream read FStream;
  end;

implementation

uses
  IdStack, IdTCPConnection, IdTCPStream, IdCoreResourceStrings,
  SysUtils;

const
  LBUFMAXSIZE = 2048;

constructor TIdStream.Create(
  AStream: TStream;
  AFreeStream: Boolean = False
  );
begin
  inherited Create;
  FStream := AStream;
  FFreeStream := AFreeStream;
end;

class function TIdStream.FindEOL(ABuf: AnsiString; var VLineBufSize: Integer; var VCrEncountered: Boolean): Integer;
var
  i: Integer;
begin
  // S.G. 25/11/2003: AnsiStrings are 1-based array. Changed initialization of I to reflect that and
  // S.G. 25/11/2003: Chnaged the relevant constants in this method
  Result := VLineBufSize; //EOL not found => use all
  i := 1; //[0..VLineBufSize-1]
  while i < VLineBufSize do begin
    case ABuf[i] of // S.G. 25/11/2003: AnsiString array are 1-based
      LF:
        begin
          Result := i-1; {string size}
          VCrEncountered := TRUE;
          VLineBufSize := i;
          BREAK;
        end;//LF
      CR:
        begin
          Result := i-1; {string size}
          VCrEncountered := TRUE;
          inc(i); //crLF?
          if (i < VLineBufSize) and (ABuf[i] = LF) then begin
            VLineBufSize := i+1;
          end
          else begin
            VLineBufSize := i;
          end;
          BREAK;
        end;//CR
    end;//case
    Inc(i);
  end;//while
End;//FindEOL

class function  TIdStream.ReadLnSplit(AStream:TStream; var AWasSplit: Boolean; AMaxLineLength: Integer = -1; AExceptionIfEOF: Boolean = FALSE): String;
begin
  Result := '';
  AWasSplit := False;
  if AStream.InheritsFrom(TIdTCPStream) then begin
    Result := TIdTCPStream(AStream).Connection.IOHandler.ReadLnSplit(AWasSplit, LF,-1,AMaxLineLength);
  end;
end;

class function TIdStream.ReadLn(AStream:TStream; AMaxLineLength: Integer = -1; AExceptionIfEOF: Boolean = FALSE): String;

                                                                            
// the coders
var
  LBufSize, LStringLen, LResultLen: LongInt;
  LBuf: TIdBytes;
 // LBuf: packed array [0..LBUFMAXSIZE] of Char;
  LStrmPos, LStrmSize: Integer; //LBytesToRead = stream size - Position
  LCrEncountered: Boolean;
begin
  // 'is' does not work here - compiler error
  if AStream.InheritsFrom(TIdTCPStream) then begin
    Result := TIdTCPStream(AStream).Connection.IOHandler.ReadLn(LF,-1,AMaxLineLength);
  end
  else begin
    SetLength(LBuf, LBUFMAXSIZE);
    if AMaxLineLength < 0 then begin
      AMaxLineLength := MaxInt;
    end;//if
    LCrEncountered := FALSE;
    Result := '';
    { we store the stream size for the whole routine to prevent
    so do not incur a performance penalty with TStream.Size.  It has
    to use something such as Seek each time the size is obtained}
    {LStrmPos := SrcStream.Position; LStrmSize:= SrcStream.Size; 4 seek vs 3 seek}
    LStrmPos := AStream.Seek(0, soFromCurrent); //Position
    LStrmSize:= AStream.Seek(0, soFromEnd); //Size
    AStream.Seek(0, soFromBeginning); //return position

    if (LStrmSize - LStrmPos) > 0 then begin

      while (LStrmPos < LStrmSize) and NOT LCrEncountered do begin
        LBufSize := Min(LStrmSize - LStrmPos, LBUFMAXSIZE);
        AStream.Read(LBuf[0], LBufSize);
        // LStringLen := TIdStream.FindEOL(BytesToString(LBuf),LBufSize,LCrEncountered);
        LStringLen := FindEOL(BytesToString(LBuf),LBufSize,LCrEncountered);
        Inc(LStrmPos,LBufSize);

        LResultLen := Length(Result);
        if (LResultLen + LStringLen) > AMaxLineLength then begin
          LStringLen := AMaxLineLength - LResultLen;
          LCrEncountered := TRUE;
          Dec(LStrmPos,LBufSize);
          Inc(LStrmPos,LStringLen);
        end; //if
        // S.G. 25/11/2003: BytesToString will copy the whole array but we nee only the
        // S.G. 25/11/2003: part up to the line length
        result := result + Copy(BytesToString(LBuf), 1, LStringLen);
        //SetLength(Result, LResultLen + LStringLen);
        //Move(LBuf[0], PChar(Result)[LResultLen], LStringLen);
      end;//while
      AStream.Position := LStrmPos;
    end
    else begin
      if AExceptionIfEOF then begin
        raise EIdEndOfStream.Create(Format(RSEndOfStream, [ClassName, LStrmPos]));
      end;
    end;//if NOT EOF
  end;//if
End;//ReadLn

{function TIdStream.ReadLn: string;

//TODO: Continue to optimize this function. Its performance severely impacts
// the coders
var
  i: Integer;
  LBuf : String;
  LBufSize, LBufPos : Integer;
  LBytesToRead : Integer; //stream size - Position
  LLn: Integer;
  LStrmPos, LStrmSize : Integer;
  LCrEncountered : Boolean;

begin
  LCrEncountered := False;
  // 'is' does not work here - compiler error
  if InheritsFrom(TIdTCPStream) then begin
    Result := TIdTCPStream(Self).Connection.ReadLn;
  end else begin
    Result := '';
    LStrmPos := Position;
    { we store the stream size for the whole routine to prevent
    so do not incur a performance penalty with TStream.Size.  It has
    to use something such as Seek each time the size is obtained
    }
{    LStrmSize := Size;
    LBytesToRead := LStrmSize - LStrmPos;
    if LBytesToRead  > 0 then begin
      LBufPos := 0;
      while (LStrmPos < LStrmSize) and (LCrEncountered = False) do
    //  while (LStrmPos <= LBytesToRead) and (LCrEncountered = False) do
      begin
        if LBufPos < LBytesToRead then
        begin
          LBufSize := Min(LBytesToRead - LBufPos,LBUFMAXSIZE);
          SetLength(LBuf, LBufSize);
          ReadBuffer(LBuf[1], LBufSize);
          for i := 1 to LBufSize do
          begin
            case LBuf[i] of
              CR : begin
                     lln := i;
                     LBufSize := i+1;
                     if (i < LBufSize) and (LBuf[LBufSize]<>LF) then
                     begin
                       Dec(LBufSize);
                     end;
                     LCrEncountered := True;
                     Break;
                   end;
              LF : begin
                     lln := i;
                     LBufSize := i+1;
                     if (i < LBufSize) and (LBuf[LBufSize]<>CR) then
                     begin
                       Dec(LBufSize);
                     end;
                     LCrEncountered := True;
                     Break;
                   end;
            end;
          end;
          if LCrEncountered then
          begin
            Dec(lln);
            SetLength(LBuf,lln);
          end;
          Inc(LStrmPos,LBufSize);

          Result := Result + LBuf;
        end;
      end;
      Position := LStrmPos;
    end;
  end;
end; }

{nction TIdStream.ReadLn: string;
//TODO: Continue to optimize this function. Its performance severely impacts
// the coders
var
  i: Integer;
  LBuf : String;
  LBufSize, LBufPos : Integer;
  LBytesToRead : Integer; //stream size - Position
  LLn: Integer;
  LStrmPos, LStrmSize : Integer;
  LCrEncountered : Boolean;
begin
  LCrEncountered := False;
  // 'is' does not work here - compiler error
  if InheritsFrom(TIdTCPStream) then begin
    Result := TIdTCPStream(Self).Connection.ReadLn;
  end else begin
    Result := '';
    LStrmPos := Position;
    { we store the stream size for the whole routine to prevent
    so do not incur a performance penalty with TStream.Size.  It has
    to use something such as Seek each time the size is obtained
    }
{   LStrmSize := Size;
    LBytesToRead := LStrmSize - LStrmPos;
    if LBytesToRead  > 0 then begin
      LBufPos := 0;
      while (LStrmPos < LStrmSize) and (LCrEncountered = False) do
    //  while (LStrmPos <= LBytesToRead) and (LCrEncountered = False) do
      begin
        if LBufPos < LBytesToRead then
        begin
          LBufSize := LBytesToRead - LBufPos;
          if LBufSize > LBUFMAXSIZE then
          begin
            LBufSize := LBUFMAXSIZE;
          end;
          SetLength(LBuf, LBufSize);
          ReadBuffer(LBuf[1], LBufSize);
          lln := IndyPos(LF, LBuf);
          i := IndyPos(CR, LBuf);
          LCrEncountered := (lln > 0) or (i > 0);
          if LCrEncountered then
          begin
            //we only want i and lln not to equal zero unless both are zero
            //The reason is that some broken things might return just a CR or a LF
            //instead of both
            if lln = 0 then
            begin
              lln := i;
            end;
            if i = 0 then
            begin
              i := lln;
            end;
            //we do these two tests to make sure the CR and LF are together.
            //if they are appart, we assume they are two different line endings.
            if (lln > (i+1)) then
            begin
              lln := i;
            end;
            if (i > (lln+1)) then
            begin
              i := lln;
            end;
            LBufSize := IdGlobal.Max(lln,i);
          end;
          Inc(LStrmPos,LBufSize);

          Result := Result + LBuf;

          if LCrEncountered then
          begin
            SetLength(Result,Min(lln,i)-1);
          end;
        end;
      end;
      Position := LStrmPos;
    end;
  end;
end;     }


procedure TIdStream.Write(AValue: string);
{$IFDEF DOTNET}
var
  LBytes: TIdBytes;
{$ENDIF}
begin
  {$IFDEF DOTNET}
  LBytes := ToBytes(AValue);
  Stream.Write(LBytes, 0, Length(LBytes));
  {$ELSE}
  Stream.WriteBuffer(AValue[1], Length(AValue));
  {$ENDIF}
end;

procedure TIdStream.WriteLn(AData: string = '');    {Do not Localize}
begin
  Write(AData + sLineBreak);
end;

procedure TIdStream.WriteLn(AData: string; AArgs: array of const);
Begin
  WriteLn(Format(AData, AArgs));
End; //

function TIdStream.BOF: Boolean;
Begin
  Result := FStream.Seek(0,soFromCurrent)<=0; //Stream.Position
End;

function TIdStream.EOF: Boolean;
var
  LPos: Int64;
Begin
  LPos := FStream.Seek(0,soFromCurrent);
  Result := LPos>=FStream.Seek(0,soFromEnd);
  FStream.Seek(LPos,soFromBeginning);
end;

procedure TIdStream.Skip(ASize: Integer);
Begin
  FStream.Seek(ASize, soFromCurrent);
End;

function TIdStream.ReadInteger: Integer;
begin
  FStream.ReadBuffer(Result, SizeOf(Result));
end;

procedure TIdStream.Write(AValue: Integer);
begin
  FStream.WriteBuffer(AValue, SizeOf(AValue));
end;

function TIdStream.ReadString: string;
var
  L: Integer;
  {$ifdef DotNet}
  LBytes:TIdBytes;
  {$endif}
Begin
  L := ReadInteger;
  if L > 0 then begin
    {$ifdef DotNet}
    FStream.ReadBuffer(LBytes,L);
    Result := BytesToString(LBytes)
    {$else}
    SetString(Result, nil, L);
    FStream.ReadBuffer(Pointer(Result)^,L);
    {$endif}
  end else begin
    Result := '';
  end;
end;

destructor TIdStream.Destroy;
begin
  if FreeStream then begin
    FreeAndNil(FStream);
  end;
  inherited;
end;

procedure TIdStream.Write(
  ABytes: TIdBytes;
  ACount: Integer = -1
  );
begin
  {$IFDEF DOTNET}
  Stream.WriteBuffer(ABytes, ACount);
  {$ELSE}
  Stream.WriteBuffer(ABytes[0], ACount);
  {$ENDIF}
end;

function TIdStream.ReadBytes(
  var ABytes: TIdBytes;
  ACount: Integer;
  AOffset: Integer = 0;
  AExceptionOnCountDiffer: Boolean = True
  ): Integer;
begin
  {$IFDEF DOTNET}
  Result := Stream.Read(ABytes, AOffset, ACount);
  {$ELSE}
  Result := Stream.Read(ABytes[AOffset], ACount);
  {$ENDIF}
  EIdException.IfTrue(AExceptionOnCountDiffer and (Result <> ACount),
    RSStreamNotEnoughBytes);
end;

end.
