paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 17:19:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Override 64-bit version, common fake seek (modified patch from Chad B - bug ID #19848)

Browse Source 
git-svn-id: trunk@18194 -
This commit is contained in:
michael 2011-08-13 18:55:50 +00:00
parent 6692595a33
commit a9c2e6a8ae
1 changed files with 20 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
packages/fcl-base/src/bufstream.pp
View File

@ -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);