* Added fakeSeekForward for benefit of descendant streams.

* Override GetSize/Position for memory/stringstream for efficiency
* Added InvalidSeek exception throwing. Should be overridden to throw custom exceptions.

git-svn-id: trunk@18190 -

rtl/objpas/classes/classesh.inc

@@ -145,6 +145,7 @@ type
   EParserError = class(Exception);
   EOutOfResources = class(EOutOfMemory);
   EInvalidOperation = class(Exception);
+  TExceptionClass = Class of Exception;
 
 { Forward class declarations }
 
@@ -767,7 +768,12 @@ type
 { TStream abstract class }
 
   TStream = class(TObject)
+  private
   protected
+    procedure InvalidSeek; virtual;
+    procedure Discard(const Count: Int64);
+    procedure DiscardLarge(Count: int64; const MaxBufferSize: Longint);
+    procedure FakeSeekForward(Offset: Int64; const Origin: TSeekOrigin; const Pos: Int64);
     function  GetPosition: Int64; virtual;
     procedure SetPosition(const Pos: Int64); virtual;
     function  GetSize: Int64; virtual;
@@ -873,9 +879,10 @@ type
     FMemory: Pointer;
     FSize, FPosition: PtrInt;
   protected
+    Function GetSize : Int64; Override;
+    function GetPosition: Int64; Override;
     procedure SetPointer(Ptr: Pointer; ASize: PtrInt);
   public
-    Function GetSize : Int64; Override;
     function Read(var Buffer; Count: LongInt): LongInt; override;
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
     procedure SaveToStream(Stream: TStream);
@@ -908,6 +915,8 @@ type
     FDataString: string;
     FPosition: Integer;
   protected
+    Function GetSize : Int64; Override;
+    function GetPosition: Int64; Override;
     procedure SetSize(NewSize: Longint); override;
   public
     constructor Create(const AString: string);

rtl/objpas/classes/streams.inc

@@ -113,6 +113,65 @@ end;
        raise EStreamError.CreateFmt(SSeekNotImplemented,[ClassName]);
     end;
 
+  procedure TStream.Discard(const Count: Int64);
+
+  const
+    CSmallSize      =255;
+    CLargeMaxBuffer =32*1024; // 32 KiB
+  var
+    Buffer: array[1..CSmallSize] of Byte;
+
+  begin
+    if Count=0 then
+      Exit;
+    if Count<=SizeOf(Buffer) then
+      ReadBuffer(Buffer,Count)
+    else
+      DiscardLarge(Count,CLargeMaxBuffer);
+  end;
+
+  procedure TStream.DiscardLarge(Count: int64; const MaxBufferSize: Longint);
+
+  var
+    Buffer: array of Byte;
+
+  begin
+    if Count=0 then
+       Exit;
+    if Count>MaxBufferSize then
+      SetLength(Buffer,MaxBufferSize)
+    else
+      SetLength(Buffer,Count);
+    while (Count>=Length(Buffer)) do
+      begin
+      ReadBuffer(Buffer[0],Length(Buffer));
+      Dec(Count,Length(Buffer));
+      end;
+    if Count>0 then
+      ReadBuffer(Buffer[0],Count);
+  end;
+
+  procedure TStream.InvalidSeek;
+
+  begin
+    raise EStreamError.CreateFmt(SStreamInvalidSeek, [ClassName]) at get_caller_addr(get_frame);
+  end;
+
+  procedure TStream.FakeSeekForward(Offset: Int64;  const Origin: TSeekOrigin; const Pos: Int64);
+
+  var
+    Buffer: Pointer;
+    BufferSize, i: LongInt;
+
+  begin
+    if Origin=soBeginning then
+       Dec(Offset,Pos);
+    if (Offset<0) or (Origin=soEnd) then
+      InvalidSeek;
+    if Offset>0 then
+      Discard(Offset);
+   end;
+
  function TStream.Seek(const Offset: Int64; Origin: TSeekorigin): Int64;
 
     begin
@@ -428,6 +487,7 @@ end;
 Constructor THandleStream.Create(AHandle: THandle);
 
 begin
+  Inherited Create;
   FHandle:=AHandle;
 end;
 
@@ -530,6 +590,11 @@ begin
   Result:=FSize;
 end;
 
+function TCustomMemoryStream.GetPosition: Int64;
+begin
+  Result:=FPosition;
+end;
+
 
 function TCustomMemoryStream.Read(var Buffer; Count: LongInt): LongInt;
 
@@ -695,6 +760,16 @@ end;
 {*                             TStringStream                                *}
 {****************************************************************************}
 
+function TStringStream.GetSize: Int64;
+begin
+  Result:=Length(FDataString);
+end;
+
+function TStringStream.GetPosition: Int64;
+begin
+  Result:=FPosition;
+end;
+
 procedure TStringStream.SetSize(NewSize: Longint);
 
 begin
@@ -740,10 +815,12 @@ begin
   Case Origin of
     soFromBeginning : FPosition:=Offset;
     soFromEnd       : FPosition:=Length(FDataString)+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
+    soFromCurrent   : FPosition:=FPosition+Offset;
   end;
-  If FPosition>Length(FDataString) then FPosition:=Length(FDataString);
-  If FPosition<0 then FPosition:=0;
+  If FPosition>Length(FDataString) then
+    FPosition:=Length(FDataString)
+  else If FPosition<0 then
+    FPosition:=0;
   Result:=FPosition;
 end;