Browse Source

* int64 file functions added

peter 24 years ago
parent
commit
f4d37ee92a
3 changed files with 127 additions and 34 deletions
  1. 19 11
      fcl/inc/classesh.inc
  2. 6 1
      fcl/inc/constse.inc
  3. 102 22
      fcl/inc/streams.inc

+ 19 - 11
fcl/inc/classesh.inc

@@ -501,18 +501,21 @@ type
 
 
   TStream = class(TObject)
   TStream = class(TObject)
   private
   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
   protected
     procedure SetSize(NewSize: Longint); virtual;
     procedure SetSize(NewSize: Longint); virtual;
+    procedure SetSize(NewSize: Int64); virtual;
   public
   public
     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
     function Write(const 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 ReadBuffer(var Buffer; Count: Longint);
     procedure WriteBuffer(const 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 ReadComponent(Instance: TComponent): TComponent;
     function ReadComponentRes(Instance: TComponent): TComponent;
     function ReadComponentRes(Instance: TComponent): TComponent;
     procedure WriteComponent(Instance: TComponent);
     procedure WriteComponent(Instance: TComponent);
@@ -530,8 +533,8 @@ type
     procedure WriteWord(w : Word);
     procedure WriteWord(w : Word);
     procedure WriteDWord(d : Cardinal);
     procedure WriteDWord(d : Cardinal);
     Procedure WriteAnsiString (S : String);
     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;
   end;
 
 
 {$ifdef HASINTF}
 {$ifdef HASINTF}
@@ -546,10 +549,14 @@ type
   THandleStream = class(TStream)
   THandleStream = class(TStream)
   private
   private
     FHandle: Integer;
     FHandle: Integer;
+  protected
+    procedure SetSize(NewSize: Longint); override;
+    procedure SetSize(NewSize: Int64); override;
   public
   public
     constructor Create(AHandle: Integer);
     constructor Create(AHandle: Integer);
     function Read(var Buffer; Count: Longint): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const 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;
     property Handle: Integer read FHandle;
   end;
   end;
 
 
@@ -558,12 +565,10 @@ type
   TFileStream = class(THandleStream)
   TFileStream = class(THandleStream)
   Private
   Private
     FFileName : String;
     FFileName : String;
-  protected
-    procedure SetSize(NewSize: Longint); override;
   public
   public
     constructor Create(const AFileName: string; Mode: Word);
     constructor Create(const AFileName: string; Mode: Word);
+    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
     destructor Destroy; override;
     destructor Destroy; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
     property FileName : String Read FFilename;
     property FileName : String Read FFilename;
   end;
   end;
 
 
@@ -1289,7 +1294,10 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 
 {
 {
   $Log$
   $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
     * criticalsection renamed to rtlcriticalsection for kylix compatibility
 
 
   Revision 1.11  2001/08/12 22:10:36  peter
   Revision 1.11  2001/08/12 22:10:36  peter

+ 6 - 1
fcl/inc/constse.inc

@@ -36,6 +36,8 @@ const
   SDuplicateClass = 'A Class with name %s exists already';
   SDuplicateClass = 'A Class with name %s exists already';
   SNoComSupport = '%s is not registered as COM-Class';
   SNoComSupport = '%s is not registered as COM-Class';
   SLineTooLong = 'Line too long';
   SLineTooLong = 'Line too long';
+  SRangeError = 'Range error';
+  SSeekNotImplemented = '64bit Seek not implemented for class %s';
 
 
   SInvalidPropertyValue = 'Invalid property value';
   SInvalidPropertyValue = 'Invalid property value';
   SInvalidPropertyPath = 'Invalid property path';
   SInvalidPropertyPath = 'Invalid property path';
@@ -273,7 +275,10 @@ const
 
 
 {
 {
   $Log$
   $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
   * Fixed SUnknownPropertyType
 
 
   Revision 1.3  2000/12/22 22:39:36  peter
   Revision 1.3  2000/12/22 22:39:36  peter

+ 102 - 22
fcl/inc/streams.inc

@@ -15,19 +15,26 @@
 {*                             TStream                                      *}
 {*                             TStream                                      *}
 {****************************************************************************}
 {****************************************************************************}
 
 
-  function TStream.GetPosition: Longint;
+  function TStream.GetPosition: Int64;
 
 
     begin
     begin
        Result:=Seek(0,soFromCurrent);
        Result:=Seek(0,soFromCurrent);
     end;
     end;
 
 
-  procedure TStream.SetPosition(Pos: Longint);
+  procedure TStream.SetPosition(Pos: Int64);
 
 
     begin
     begin
        Seek(pos,soFromBeginning);
        Seek(pos,soFromBeginning);
     end;
     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
     var
        p : longint;
        p : longint;
@@ -45,6 +52,55 @@
     // As wel as possible read-ony streams !!
     // As wel as possible read-ony streams !!
     end;
     end;
 
 
+  procedure TStream.SetSize(NewSize: Int64);
+
+    begin
+      // Backwards compatibility that calls the longint SetSize
+      if (NewSize<Low(longint)) or
+         (NewSize>High(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:[email protected];
+         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 (Offset<Low(longint)) or
+         (Offset>High(longint)) then
+        raise ERangeError.Create(SRangeError);
+      Seek(longint(Offset),ord(Origin));
+    end;
+
   procedure TStream.ReadBuffer(var Buffer; Count: Longint);
   procedure TStream.ReadBuffer(var Buffer; Count: Longint);
 
 
     begin
     begin
@@ -59,10 +115,10 @@
          Raise EWriteError.Create(SWriteError);
          Raise EWriteError.Create(SWriteError);
     end;
     end;
 
 
-  function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;
+  function TStream.CopyFrom(Source: TStream; Count: Int64): Int64;
 
 
     var
     var
-       i : longint;
+       i : Int64;
        buffer : array[0..1023] of byte;
        buffer : array[0..1023] of byte;
 
 
     begin
     begin
@@ -134,13 +190,13 @@
        Driver := TBinaryObjectWriter.Create(Self, 4096);
        Driver := TBinaryObjectWriter.Create(Self, 4096);
        Try
        Try
          Writer := TWriter.Create(Driver);
          Writer := TWriter.Create(Driver);
-	 Try
+         Try
            Writer.WriteDescendent(Instance, Ancestor);
            Writer.WriteDescendent(Instance, Ancestor);
-	 Finally
-	   Writer.Destroy;
-	 end;
+         Finally
+           Writer.Destroy;
+         end;
        Finally
        Finally
-	 Driver.Free;
+         Driver.Free;
        end;
        end;
 
 
     end;
     end;
@@ -327,6 +383,25 @@ begin
 end;
 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;
 end;
 
 
 
 
-destructor TFileStream.Destroy;
-
-begin
-  FileClose(FHandle);
-end;
-
-Procedure TFileStream.SetSize(NewSize: Longint);
+constructor TFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
 
 
 begin
 begin
-  FileTruncate(FHandle,NewSize);
+  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;
 end;
 
 
 
 
-function TFileStream.Seek(Offset: Longint; Origin: Word): Longint;
+destructor TFileStream.Destroy;
 
 
 begin
 begin
-  Result:=FileSeek(FHandle,Offset,Origin);
+  FileClose(FHandle);
 end;
 end;
 
 
-
 {****************************************************************************}
 {****************************************************************************}
 {*                             TCustomMemoryStream                          *}
 {*                             TCustomMemoryStream                          *}
 {****************************************************************************}
 {****************************************************************************}
@@ -656,7 +733,10 @@ end;
 
 
 {
 {
   $Log$
   $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
   + Merged changes, fixed stringstream
 
 
   Revision 1.2  2000/07/13 11:33:00  michael
   Revision 1.2  2000/07/13 11:33:00  michael