mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 20:31:57 +02:00
* int64 file functions added
This commit is contained in:
peter
parent
00a1625ce3
commit
f4d37ee92a
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 (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:=@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 (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);
|
||||
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user