From f4d37ee92aceee7f57feb82996fba742d3bc9a8d Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 28 Oct 2001 17:16:44 +0000 Subject: [PATCH] * int64 file functions added --- fcl/inc/classesh.inc | 30 ++++++---- fcl/inc/constse.inc | 7 ++- fcl/inc/streams.inc | 130 ++++++++++++++++++++++++++++++++++--------- 3 files changed, 130 insertions(+), 37 deletions(-) diff --git a/fcl/inc/classesh.inc b/fcl/inc/classesh.inc index bc3f9dc49e..f93ada53b6 100644 --- a/fcl/inc/classesh.inc +++ b/fcl/inc/classesh.inc @@ -501,18 +501,21 @@ type TStream = class(TObject) private - function GetPosition: Longint; - procedure SetPosition(Pos: Longint); - function GetSize: Longint; + function GetPosition: Int64; + procedure SetPosition(Pos: Int64); + function GetSize: Int64; + procedure SetSize64(NewSize: Int64); protected procedure SetSize(NewSize: Longint); virtual; + procedure SetSize(NewSize: Int64); virtual; public function Read(var Buffer; Count: Longint): Longint; virtual; abstract; function Write(const Buffer; Count: Longint): Longint; virtual; abstract; - function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract; + function Seek(Offset: Longint; Origin: Word): Longint; virtual; + function Seek(Offset: Int64; Origin: TSeekOrigin): Int64; virtual; procedure ReadBuffer(var Buffer; Count: Longint); procedure WriteBuffer(const Buffer; Count: Longint); - function CopyFrom(Source: TStream; Count: Longint): Longint; + function CopyFrom(Source: TStream; Count: Int64): Int64; function ReadComponent(Instance: TComponent): TComponent; function ReadComponentRes(Instance: TComponent): TComponent; procedure WriteComponent(Instance: TComponent); @@ -530,8 +533,8 @@ type procedure WriteWord(w : Word); procedure WriteDWord(d : Cardinal); Procedure WriteAnsiString (S : String); - property Position: Longint read GetPosition write SetPosition; - property Size: Longint read GetSize write SetSize; + property Position: Int64 read GetPosition write SetPosition; + property Size: Int64 read GetSize write SetSize64; end; {$ifdef HASINTF} @@ -546,10 +549,14 @@ type THandleStream = class(TStream) private FHandle: Integer; + protected + procedure SetSize(NewSize: Longint); override; + procedure SetSize(NewSize: Int64); override; public constructor Create(AHandle: Integer); function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Int64; Origin: TSeekOrigin): Int64; override; property Handle: Integer read FHandle; end; @@ -558,12 +565,10 @@ type TFileStream = class(THandleStream) Private FFileName : String; - protected - procedure SetSize(NewSize: Longint); override; public constructor Create(const AFileName: string; Mode: Word); + constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal); destructor Destroy; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; property FileName : String Read FFilename; end; @@ -1289,7 +1294,10 @@ function LineStart(Buffer, BufPos: PChar): PChar; { $Log$ - Revision 1.12 2001-10-23 21:51:02 peter + Revision 1.13 2001-10-28 17:16:44 peter + * int64 file functions added + + Revision 1.12 2001/10/23 21:51:02 peter * criticalsection renamed to rtlcriticalsection for kylix compatibility Revision 1.11 2001/08/12 22:10:36 peter diff --git a/fcl/inc/constse.inc b/fcl/inc/constse.inc index 97efff23de..c163e6b168 100644 --- a/fcl/inc/constse.inc +++ b/fcl/inc/constse.inc @@ -36,6 +36,8 @@ const SDuplicateClass = 'A Class with name %s exists already'; SNoComSupport = '%s is not registered as COM-Class'; SLineTooLong = 'Line too long'; + SRangeError = 'Range error'; + SSeekNotImplemented = '64bit Seek not implemented for class %s'; SInvalidPropertyValue = 'Invalid property value'; SInvalidPropertyPath = 'Invalid property path'; @@ -273,7 +275,10 @@ const { $Log$ - Revision 1.4 2000-12-23 22:54:50 sg + Revision 1.5 2001-10-28 17:16:44 peter + * int64 file functions added + + Revision 1.4 2000/12/23 22:54:50 sg * Fixed SUnknownPropertyType Revision 1.3 2000/12/22 22:39:36 peter diff --git a/fcl/inc/streams.inc b/fcl/inc/streams.inc index 4c6736a35d..4289a3f1c7 100644 --- a/fcl/inc/streams.inc +++ b/fcl/inc/streams.inc @@ -15,19 +15,26 @@ {* TStream *} {****************************************************************************} - function TStream.GetPosition: Longint; + function TStream.GetPosition: Int64; begin Result:=Seek(0,soFromCurrent); end; - procedure TStream.SetPosition(Pos: Longint); + procedure TStream.SetPosition(Pos: Int64); begin Seek(pos,soFromBeginning); end; - function TStream.GetSize: Longint; + procedure TStream.SetSize64(NewSize: Int64); + + begin + // Required because can't use overloaded functions in properties + SetSize(NewSize); + end; + + function TStream.GetSize: Int64; var p : longint; @@ -45,6 +52,55 @@ // As wel as possible read-ony streams !! end; + procedure TStream.SetSize(NewSize: Int64); + + begin + // Backwards compatibility that calls the longint SetSize + if (NewSizeHigh(longint)) then + raise ERangeError.Create(SRangeError); + SetSize(longint(NewSize)); + end; + + function TStream.Seek(Offset: Longint; Origin: Word): Longint; + + type + TSeek64 = function(offset:Int64;Origin:TSeekorigin):Int64 of object; + var + CurrSeek, + TStreamSeek : TSeek64; + CurrClass : TClass; + begin + // Redirect calls to 64bit Seek, but we can't call the 64bit Seek + // from TStream, because then we end up in an infinite loop + CurrSeek:=nil; + CurrClass:=Classtype; + while (CurrClass<>nil) and + (CurrClass<>TStream) do + CurrClass:=CurrClass.Classparent; + if CurrClass<>nil then + begin + CurrSeek:=@Self.Seek; + TStreamSeek:=@TStream(CurrClass).Seek; + if TMethod(TStreamSeek).Code=TMethod(CurrSeek).Code then + CurrSeek:=nil; + end; + if CurrSeek<>nil then + Result:=Seek(Int64(offset),TSeekOrigin(origin)) + else + raise EStreamError.CreateFmt(SSeekNotImplemented,[ClassName]); + end; + + function TStream.Seek(Offset: Int64; Origin: TSeekorigin): Int64; + + begin + // Backwards compatibility that calls the longint Seek + if (OffsetHigh(longint)) then + raise ERangeError.Create(SRangeError); + Seek(longint(Offset),ord(Origin)); + end; + procedure TStream.ReadBuffer(var Buffer; Count: Longint); begin @@ -59,10 +115,10 @@ Raise EWriteError.Create(SWriteError); end; - function TStream.CopyFrom(Source: TStream; Count: Longint): Longint; + function TStream.CopyFrom(Source: TStream; Count: Int64): Int64; var - i : longint; + i : Int64; buffer : array[0..1023] of byte; begin @@ -134,13 +190,13 @@ Driver := TBinaryObjectWriter.Create(Self, 4096); Try Writer := TWriter.Create(Driver); - Try + Try Writer.WriteDescendent(Instance, Ancestor); - Finally - Writer.Destroy; - end; + Finally + Writer.Destroy; + end; Finally - Driver.Free; + Driver.Free; end; end; @@ -327,6 +383,25 @@ begin end; +Procedure THandleStream.SetSize(NewSize: Longint); + +begin + SetSize(Int64(NewSize)); +end; + + +Procedure THandleStream.SetSize(NewSize: Int64); + +begin + FileTruncate(FHandle,NewSize); +end; + + +function THandleStream.Seek(Offset: Int64; Origin: TSeekOrigin): Int64; + +begin + Result:=FileSeek(FHandle,Offset,ord(Origin)); +end; {****************************************************************************} @@ -349,26 +424,28 @@ begin end; +constructor TFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal); + +begin + FFileName:=AFileName; + If Mode=fmcreate then + FHandle:=FileCreate(AFileName) + else + FHAndle:=FileOpen(AFileName,Mode); + If FHandle<0 then + If Mode=fmcreate then + raise EFCreateError.createfmt(SFCreateError,[AFileName]) + else + raise EFOpenError.Createfmt(SFOpenError,[AFilename]); +end; + + destructor TFileStream.Destroy; begin FileClose(FHandle); end; -Procedure TFileStream.SetSize(NewSize: Longint); - -begin - FileTruncate(FHandle,NewSize); -end; - - -function TFileStream.Seek(Offset: Longint; Origin: Word): Longint; - -begin - Result:=FileSeek(FHandle,Offset,Origin); -end; - - {****************************************************************************} {* TCustomMemoryStream *} {****************************************************************************} @@ -656,7 +733,10 @@ end; { $Log$ - Revision 1.3 2001-03-08 19:38:32 michael + Revision 1.4 2001-10-28 17:16:44 peter + * int64 file functions added + + Revision 1.3 2001/03/08 19:38:32 michael + Merged changes, fixed stringstream Revision 1.2 2000/07/13 11:33:00 michael