Browse Source

--- Merging r18190 into '.':
U rtl/objpas/classes/streams.inc
U rtl/objpas/classes/classesh.inc
--- Merging r18191 into '.':
U packages/fcl-base/src/idea.pp
--- Merging r18192 into '.':
U packages/fcl-base/src/blowfish.pp
--- Merging r18193 into '.':
U packages/fcl-base/src/iostream.pp
--- Merging r18194 into '.':
U packages/fcl-base/src/bufstream.pp
--- Merging r18195 into '.':
U packages/fcl-process/src/os2/pipes.inc
U packages/fcl-process/src/unix/pipes.inc
U packages/fcl-process/src/win/pipes.inc
U packages/fcl-process/src/pipes.pp
--- Merging r18196 into '.':
U packages/fcl-res/src/resdatastream.pp
--- Merging r18198 into '.':
U utils/fpcres/closablefilestream.pas
--- Merging r18211 into '.':
U packages/fcl-process/src/dummy/pipes.inc

# revisions: 18190,18191,18192,18193,18194,18195,18196,18198,18211
------------------------------------------------------------------------
r18190 | michael | 2011-08-13 20:45:48 +0200 (Sat, 13 Aug 2011) | 4 lines
Changed paths:
M /trunk/rtl/objpas/classes/classesh.inc
M /trunk/rtl/objpas/classes/streams.inc

* 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.

------------------------------------------------------------------------
------------------------------------------------------------------------
r18191 | michael | 2011-08-13 20:48:23 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/idea.pp

* Fix 19850 (modified patch by Chad B)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18192 | michael | 2011-08-13 20:49:51 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/blowfish.pp

* Fix 19849 (modified patch by Chad B)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18193 | michael | 2011-08-13 20:51:23 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/iostream.pp

* Fix 19851 19852 19855 (modified patch by Chad B)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18194 | michael | 2011-08-13 20:55:50 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/bufstream.pp

* Override 64-bit version, common fake seek (modified patch from Chad B - bug ID #19848)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18195 | michael | 2011-08-13 20:58:04 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-process/src/os2/pipes.inc
M /trunk/packages/fcl-process/src/pipes.pp
M /trunk/packages/fcl-process/src/unix/pipes.inc
M /trunk/packages/fcl-process/src/win/pipes.inc

* Fix bug ID #19856 (adapted and completed patch by Chad B)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18196 | michael | 2011-08-13 20:59:33 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-res/src/resdatastream.pp

* Fixed bug ID #19856 and bug ID #19857 (modified patch from Chad B)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18198 | michael | 2011-08-13 21:15:20 +0200 (Sat, 13 Aug 2011) | 1 line
Changed paths:
M /trunk/utils/fpcres/closablefilestream.pas

* Override correct seek/setsize version (Patch by Chad B)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18211 | florian | 2011-08-14 22:54:28 +0200 (Sun, 14 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-process/src/dummy/pipes.inc

+ add new functions to dummy/pipes.inc, fixes WinCE building
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@18954 -

marco 14 years ago
parent
commit
49aa178bd2

+ 20 - 20
packages/fcl-base/src/blowfish.pp

@@ -55,6 +55,9 @@ Type
     FData   : TBFBlock;
     FBufpos : Byte;
     FPos    : Int64;
+  protected
+    function GetPosition: Int64; override;
+    procedure InvalidSeek; override;
   Public
     Constructor Create(AKey : TBlowFishKey; AKeySize : Byte; Dest: TStream);
     Constructor Create(Const KeyPhrase : String; Dest: TStream);
@@ -66,14 +69,14 @@ Type
   public
     Destructor Destroy; override;
     function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
     procedure Flush;
   end;
 
   TBlowFishDeCryptStream = Class(TBlowFishStream)
   public
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
   end;
 
 Implementation
@@ -538,6 +541,15 @@ end;
     TBlowFishStream
   ---------------------------------------------------------------------}
 
+function TBlowFishStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TBlowFishStream.InvalidSeek;
+begin
+  raise EBlowFishError.Create(SNoSeekAllowed);
+end;
 
 Constructor TBlowFishStream.Create(AKey : TBlowFishkey; AKeySize : Byte; Dest: TStream);
 
@@ -626,13 +638,13 @@ begin
 end;
 
 
-function TBlowFishEncryptStream.Seek(Offset: Longint; Origin: Word): Longint;
+function TBlowFishEncryptStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
 
 begin
-  if (Offset = 0) and (Origin = soFromCurrent) then
+  if (Offset = 0) and (Origin = soCurrent) then
     Result := FPos
   else
-    Raise EBlowFishError.Create(SNoSeekAllowed);
+    InvalidSeek;
 end;
 
 
@@ -682,23 +694,11 @@ begin
   Inc(FPos,Result);
 end;
 
-function TBlowFishDeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-Var Buffer : Array[0..1023] of byte;
-    i : longint;
+function TBlowFishDeCryptStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
 
 begin
-  // Fake seek if possible by reading and discarding bytes.
-  If ((Offset>=0) and (Origin = soFromCurrent)) or
-    ((Offset>FPos) and (Origin = soFromBeginning)) then
-      begin
-      For I:=1 to (Offset div SizeOf(Buffer)) do
-        ReadBuffer(Buffer,SizeOf(Buffer));
-      ReadBuffer(Buffer,Offset mod SizeOf(Buffer));
-      Result:=FPos;
-      end
-  else
-    Raise EBlowFishError.Create(SNoSeekAllowed);
+  FakeSeekForward(Offset,TSeekOrigin(Origin),FPos);
+  Result:=FPos;
 end;
 
 end.

+ 20 - 25
packages/fcl-base/src/bufstream.pp

@@ -38,6 +38,8 @@ Type
     FCapacity: Integer;
     procedure SetCapacity(const AValue: Integer);
   Protected
+    function GetPosition: Int64; override;
+    function GetSize: Int64; override;
     procedure BufferError(const Msg : String);
     Procedure FillBuffer; Virtual;
     Procedure FlushBuffer; Virtual;
@@ -55,7 +57,7 @@ Type
 
   TReadBufStream = Class(TBufStream)
   Public
-    Function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
     Function Read(var ABuffer; ACount : LongInt) : Integer; override;
   end;
 
@@ -64,7 +66,7 @@ Type
   TWriteBufStream = Class(TBufStream)
   Public
     Destructor Destroy; override;
-    Function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
   end;
 
@@ -88,6 +90,16 @@ begin
     end;
 end;
 
+function TBufStream.GetPosition: Int64;
+begin
+  Result:=FTotalPos;
+end;
+
+function TBufStream.GetSize: Int64;
+begin
+  Result:=Source.Size;
+end;
+
 procedure TBufStream.BufferError(const Msg: String);
 begin
   Raise EStreamError.Create(Msg);
@@ -162,29 +174,11 @@ end;
 
 { TReadBufStream }
 
-function TReadBufStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-var
-  I: Integer;
-  Buf: array [0..4095] of Char;
+function TReadBufStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
 
 begin
-  // Emulate forward seek if possible.
-  if ((Offset>=0) and (Origin = soFromCurrent)) or
-     (((Offset-FTotalPos)>=0) and (Origin = soFromBeginning)) then
-    begin
-    if (Origin=soFromBeginning) then
-      Dec(Offset,FTotalPos);
-    if (Offset>0) then
-      begin
-      for I:=1 to (Offset div sizeof(Buf)) do
-        ReadBuffer(Buf,sizeof(Buf));
-      ReadBuffer(Buf, Offset mod sizeof(Buf));
-      end;
-    Result:=FTotalPos;
-    end
-  else
-    BufferError(SErrInvalidSeek);
+  FakeSeekForward(Offset,Origin,FTotalPos);
+  Result:=FTotalPos; // Pos updated by fake read
 end;
 
 function TReadBufStream.Read(var ABuffer; ACount: LongInt): Integer;
@@ -226,9 +220,10 @@ begin
   inherited Destroy;
 end;
 
-function TWriteBufStream.Seek(Offset: Longint; Origin: Word): Longint;
+function TWriteBufStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+
 begin
-  if (Offset=0) and (Origin=soFromCurrent) then
+  if (Offset=0) and (Origin=soCurrent) then
     Result := FTotalPos
   else
     BufferError(SErrInvalidSeek);

+ 18 - 18
packages/fcl-base/src/idea.pp

@@ -78,8 +78,10 @@ Type
     FKey    : TIDEAKey;
     FData   : TIDEACryptData;
     FBufpos : Byte;
-    FPos    : Longint;
+    FPos    : Int64;
   Protected
+    function GetPosition: Int64; override;
+    procedure InvalidSeek; override;
     Procedure CreateCryptKey(Const S : String; Var Key : TIDEACryptKey);
   Public
     Constructor Create(AKey : TIDEAKey; Dest: TStream); overload;
@@ -103,7 +105,7 @@ Type
   public
     Constructor Create(Const AKey : String; Dest: TStream); overload;
     function Read(var Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
   end;
 
 Implementation
@@ -266,6 +268,16 @@ begin
   Fpos:=0;
 end;
 
+function TIDEAStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TIDEAStream.InvalidSeek;
+begin
+  Raise EIDEAError.Create(SNoSeekAllowed);
+end;
+
 procedure TIDEAStream.CreateCryptKey(const S: String; var Key: TIDEACryptKey);
 
 Var
@@ -359,7 +371,7 @@ begin
   if (Offset = 0) and (Origin = soFromCurrent) then
     Result := FPos
   else
-    Raise EIDEAError.Create(SNoSeekAllowed);
+    InvalidSeek;
 end;
 
 
@@ -422,23 +434,11 @@ begin
   Inc(FPos,Result);
 end;
 
-function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-Var Buffer : Array[0..1023] of byte;
-    i : longint;
+function TIDEADeCryptStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
 
 begin
-  // Fake seek if possible by reading and discarding bytes.
-  If ((Offset>=0) and (Origin = soFromCurrent)) or
-    ((Offset>FPos) and (Origin = soFromBeginning)) then
-      begin
-      For I:=1 to (Offset div SizeOf(Buffer)) do
-        ReadBuffer(Buffer,SizeOf(Buffer));
-      ReadBuffer(Buffer,Offset mod SizeOf(Buffer));
-      Result:=FPos;
-      end
-  else
-    Raise EIDEAError.Create(SNoSeekAllowed);
+  FakeSeekForward(Offset,Origin,fpos);
+  Result:=FPos; // FPos updated by read
 end;
 
 END.

+ 33 - 27
packages/fcl-base/src/iostream.pp

@@ -22,17 +22,22 @@ type
   TIOSType = (iosInput,iosOutPut,iosError);
   EIOStreamError = class(EStreamError);
 
+  { TIOStream }
+
   TIOStream = class(THandleStream)
   private
     FType : longint;
     FPos : Int64;
     zIOSType : TIOSType;
+  protected
+    procedure SetSize(const NewSize: Int64); override;
+    function  GetPosition: Int64; override;
+    procedure InvalidSeek; override;
   public
     constructor Create(aIOSType : TiosType);
     function Read(var Buffer; Count : LongInt) : Longint; override;
     function Write(const Buffer; Count : LongInt) : LongInt; override;
-    procedure SetSize(NewSize: Longint); override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
     end;
 
 implementation
@@ -42,9 +47,24 @@ const
   SWriteOnlyStream = 'Cannot read from an output stream.';
   SInvalidOperation = 'Cannot perform this operation on a IOStream.';
 
+procedure TIOStream.SetSize(const NewSize: Int64);
+begin
+  raise EIOStreamError.Create(SInvalidOperation);
+end;
+
+function TIOStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TIOStream.InvalidSeek;
+begin
+  raise EIOStreamError.Create(SInvalidOperation);
+end;
+
 constructor TIOStream.Create(aIOSType : TIOSType);
 begin
-{$ifdef win32}
+{$ifdef windows}
   case aIOSType of
     iosInput : FType := StdInputHandle;
     iosOutput : FType := StdOutputHandle;
@@ -77,32 +97,18 @@ begin
   end;
 end;
 
-procedure TIOStream.SetSize(NewSize: Longint);
-begin
-  raise EIOStreamError.Create(SInvalidOperation);
-end;
 
-function TIOStream.Seek(Offset: Longint; Origin: Word): Longint;
-const
-  BufSize = 1024;
-var
-  Buf : array[1..BufSize] of Byte;
+function TIOStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
 begin
-  If (Origin=soFromCurrent) and (Offset=0) then
-     result:=FPos;
-  { Try to fake seek by reading and discarding }
-  if (zIOSType = iosOutput) or
-     Not((Origin=soFromCurrent) and (Offset>=0) or
-         ((Origin=soFrombeginning) and (OffSet>=FPos))) then
-     Raise EIOStreamError.Create(SInvalidOperation);
-  if Origin=soFromBeginning then
-    Dec(Offset,FPos);
-  While ((Offset Div BufSize)>0)
-        and (Read(Buf,SizeOf(Buf))=BufSize) do
-     Dec(Offset,BufSize);
-  If (Offset>0) then
-    Read(Buf,BufSize);
-  Result:=FPos;
+  if (Origin=soCurrent) and (Offset=0) then
+    Result:=FPos
+  else
+    begin
+    if zIOSType in [iosOutput,iosError] then
+      InvalidSeek;
+    FakeSeekForward(Offset,Origin,FPos);
+    Result:=FPos;
+    end;
 end;
 
 end.

+ 9 - 0
packages/fcl-process/src/dummy/pipes.inc

@@ -28,3 +28,12 @@ begin
   Result := 0;
 end;
 
+function TInputPipeStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TInputPipeStream.InvalidSeek;
+begin
+  Raise EPipeSeek.Create (ENoSeekMsg);
+end;

+ 10 - 0
packages/fcl-process/src/os2/pipes.inc

@@ -32,3 +32,13 @@ begin
   Result := 0;
 end;
 
+function TInputPipeStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TInputPipeStream.InvalidSeek;
+begin
+  Raise EPipeSeek.Create (ENoSeekMsg);
+end;
+

+ 9 - 22
packages/fcl-process/src/pipes.pp

@@ -32,16 +32,19 @@ Type
     Private
       FPos : Int64;
       function GetNumBytesAvailable: DWord;
+    protected
+      function GetPosition: Int64; override;
+      procedure InvalidSeek; override;
     public
       Function Write (Const Buffer; Count : Longint) :Longint; Override;
-      Function Seek (Offset : Longint;Origin : Word) : longint;override;
+      function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
       Function Read (Var Buffer; Count : Longint) : longint; Override;
       property NumBytesAvailable: DWord read GetNumBytesAvailable;
     end;
 
   TOutputPipeStream = Class(THandleStream)
     Public
-      Function Seek (Offset : Longint;Origin : Word) : longint;override;
+      function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
       Function Read (Var Buffer; Count : Longint) : longint; Override;
     end;
 
@@ -90,26 +93,10 @@ begin
   Inc(FPos,Result);
 end;
 
-Function TInputPipeStream.Seek (Offset : Longint;Origin : Word) : longint;
-
-Const BufSize = 100;
-
-Var Buf : array[1..BufSize] of Byte;
+function TInputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
 
 begin
-  If (Origin=soFromCurrent) and (Offset=0) then
-     result:=FPos;
-  { Try to fake seek by reading and discarding }
-  if Not((Origin=soFromCurrent) and (Offset>=0) or
-         ((Origin=soFrombeginning) and (OffSet>=FPos))) then
-     Raise EPipeSeek.Create(ENoSeekMSg);
-  if Origin=soFromBeginning then
-    Dec(Offset,FPos);
-  While ((Offset Div BufSize)>0)
-        and (Read(Buf,SizeOf(Buf))=BufSize) do
-     Dec(Offset,BufSize);
-  If (Offset>0) then
-    Read(Buf,BufSize);
+  FakeSeekForward(Offset,Origin,FPos);
   Result:=FPos;
 end;
 
@@ -124,10 +111,10 @@ begin
   Result := 0;
 end;
 
-Function TOutputPipeStream.Seek (Offset : Longint;Origin : Word) : longint;
+function TOutputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
 
 begin
-  Raise EPipeSeek.Create (ENoSeekMsg);
+  InvalidSeek;
 end;
 
 end.

+ 10 - 0
packages/fcl-process/src/unix/pipes.inc

@@ -30,3 +30,13 @@ begin
     Result := 0;
 end;
 
+function TInputPipeStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TInputPipeStream.InvalidSeek;
+begin
+  Raise EPipeSeek.Create (ENoSeekMsg);
+end;
+

+ 9 - 0
packages/fcl-process/src/win/pipes.inc

@@ -41,3 +41,12 @@ begin
     Result := 0;
 end;
 
+function TInputPipeStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TInputPipeStream.InvalidSeek;
+begin
+  Raise EPipeSeek.Create (ENoSeekMsg);
+end;

+ 2 - 38
packages/fcl-res/src/resdatastream.pp

@@ -33,12 +33,9 @@ type
     procedure SetPosition(const Pos: Int64); override;
     function  GetSize: Int64; override;
     procedure SetSize64(const NewSize: Int64); override;
-    procedure SetSize(NewSize: Longint); override;
-    procedure SetSize(const NewSize: Int64); override;
   public
     constructor Create(aStream : TStream; aResource : TAbstractResource; aSize : int64); virtual;
     function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
   end;
 
@@ -74,8 +71,6 @@ type
     procedure SetPosition(const Pos: Int64); override;
     function  GetSize: Int64; override;
     procedure SetSize64(const NewSize: Int64); override;
-    procedure SetSize(NewSize: Longint); override;
-    procedure SetSize(const NewSize: Int64); override;
   public
     constructor Create(aStream : TStream; aResource : TAbstractResource; aSize : int64; aClass: TCachedStreamClass);
     destructor Destroy; override;
@@ -83,7 +78,6 @@ type
     procedure SetCustomStream(aStream : TStream);
     function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
     property Cached : boolean read GetCached write SetCached;
   end;
@@ -112,16 +106,6 @@ begin
   raise EInvalidOperation.Create('');
 end;
 
-procedure TCachedDataStream.SetSize(NewSize: Longint);
-begin
-  SetSize64(NewSize);
-end;
-
-procedure TCachedDataStream.SetSize(const NewSize: Int64);
-begin
- SetSize64(NewSize);
-end;
-
 constructor TCachedDataStream.Create(aStream: TStream;  aResource : TAbstractResource; aSize : int64);
 begin
   fStream:=aStream;
@@ -134,12 +118,6 @@ begin
   raise EInvalidOperation.Create('');
 end;
 
-function TCachedDataStream.Seek(Offset: Longint; Origin: Word
-  ): Longint;
-begin
-  Result:=Seek(Offset,TSeekOrigin(Origin));
-end;
-
 function TCachedDataStream.Seek(const Offset: Int64; Origin: TSeekOrigin
   ): Int64;
 var newpos : int64;
@@ -147,7 +125,7 @@ begin
   case Origin of
     soBeginning : newpos:=Offset;
     soCurrent : newpos:=Position+Offset;
-    soEnd : newpos:=fSize-Offset;
+    soEnd : newpos:=fSize+Offset;
   end;
   SetPosition(newpos);
   Result:=Position;
@@ -232,16 +210,6 @@ begin
   fStream.Size:=NewSize;
 end;
 
-procedure TResourceDataStream.SetSize(NewSize: Longint);
-begin
-  SetSize64(NewSize);
-end;
-
-procedure TResourceDataStream.SetSize(const NewSize: Int64);
-begin
-  SetSize64(NewSize);
-end;
-
 constructor TResourceDataStream.Create(aStream: TStream; aResource :
   TAbstractResource; aSize : int64; aClass: TCachedStreamClass);
 begin
@@ -327,10 +295,6 @@ begin
   Result:=fStream.Write(Buffer,Count);
 end;
 
-function TResourceDataStream.Seek(Offset: Longint; Origin: Word): Longint;
-begin
-  Result:=Seek(Offset,TSeekOrigin(Origin));
-end;
 
 function TResourceDataStream.Seek(const Offset: Int64; Origin: TSeekOrigin
   ): Int64;
@@ -339,7 +303,7 @@ begin
   case Origin of
     soBeginning : newpos:=Offset;
     soCurrent : newpos:=Position+Offset;
-    soEnd : newpos:=Size-Offset;
+    soEnd : newpos:=Size+Offset;
   end;
   SetPosition(newpos);
   Result:=Position;

+ 12 - 3
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,15 +768,20 @@ 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;
     procedure SetSize64(const NewSize: Int64); virtual;
     procedure SetSize(NewSize: Longint); virtual;overload;
     procedure SetSize(const NewSize: Int64); virtual;overload;
-	  procedure ReadNotImplemented;
-	  procedure WriteNotImplemented;
+    procedure ReadNotImplemented;
+    procedure WriteNotImplemented;
   public
     function Read(var Buffer; Count: Longint): Longint; virtual;
     function Write(const Buffer; Count: Longint): Longint; 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);

+ 81 - 4
rtl/objpas/classes/streams.inc

@@ -113,7 +113,66 @@ end;
        raise EStreamError.CreateFmt(SSeekNotImplemented,[ClassName]);
     end;
 
-  function TStream.Seek(const Offset: Int64; Origin: TSeekorigin): Int64;
+  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
       // Backwards compatibility that calls the longint Seek
@@ -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;
 

+ 0 - 13
utils/fpcres/closablefilestream.pas

@@ -37,7 +37,6 @@ type
     fPosition : int64;
     procedure EnsureHandleOpen;
   protected
-    procedure SetSize(NewSize: Longint); override;
     procedure SetSize(const NewSize: Int64); override;
     function RetryOpen : boolean;
   public
@@ -45,7 +44,6 @@ type
     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;
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
     procedure CloseHandle;
 end;
@@ -225,11 +223,6 @@ begin
   fListener.NotifyFileOpened(self);
 end;
 
-procedure TClosableFileStream.SetSize(NewSize: Longint);
-begin
-  SetSize(int64(NewSize));
-end;
-
 procedure TClosableFileStream.SetSize(const NewSize: Int64);
 begin
   EnsureHandleOpen;
@@ -279,12 +272,6 @@ begin
   Result:=fStream.Write(Buffer,Count);
 end;
 
-function TClosableFileStream.Seek(Offset: Longint; Origin: Word): Longint;
-begin
-  EnsureHandleOpen;
-  Result:=fStream.Seek(Offset,Origin);
-end;
-
 function TClosableFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin
   ): Int64;
 begin