paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-28 20:43:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ FileTruncate allows 64-bit parameter

Browse Source 
git-svn-id: trunk@6727 -
This commit is contained in:
Tomas Hajny 2007-03-05 23:47:10 +00:00
parent c7fc744a2a
commit 5e1a7997ee
16 changed files with 78 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/amiga/sysutils.pp
View File

@ -206,11 +206,13 @@ begin
end;
function FileTruncate(Handle, Size: LongInt): Boolean;
function FileTruncate(Handle: longint; Size: Int64): Boolean;
var
dosResult: LongInt;
begin
FileTruncate:=False;
if Size > high (longint) then exit;
{$WARNING Possible support for 64-bit FS to be checked!}
if (Handle<=0) then exit;
dosResult:=SetFileSize(Handle, Size, OFFSET_BEGINNING);

2
rtl/beos/sysutils.pp
View File

@ -81,7 +81,7 @@ begin
end;
Function FileTruncate (Handle,Size: Longint) : boolean;
Function FileTruncate (Handle: longint;Size: Int64) : boolean;
begin
end;

8
rtl/emx/sysutils.pp
View File

@ -513,15 +513,19 @@ begin
end;
function FileTruncate (Handle, Size: longint): boolean; assembler;
function FileTruncate (Handle: THandle; Size: Int64): boolean; assembler;
asm
push ebx
{$IFDEF REGCALL}
mov ebx, eax
{$ELSE REGCALL}
mov ebx, Handle
mov edx, Size
{$ENDIF REGCALL}
mov edx, dword ptr Size
mov eax, dword ptr Size+4
or eax, eax
mov eax, 0
jz @FTruncEnd (* file sizes > 4 GB not supported with EMX *)
mov eax, 7F25h
push ebx
call syscall

2
rtl/gba/sysutils.pp
View File

@ -102,7 +102,7 @@ begin
end;
function FileTruncate(Handle, Size: LongInt): Boolean;
function FileTruncate(Handle: THandle; Size: Int64): Boolean;
begin
result := false;
end;

23
rtl/go32v2/sysutils.pp
View File

@ -240,18 +240,23 @@ begin
end;
Function FileTruncate (Handle,Size: Longint) : boolean;
Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
var
regs : trealregs;
begin
FileSeek(Handle,Size,0);
Regs.realecx := 0;
Regs.realedx := tb_offset;
Regs.ds := tb_segment;
Regs.ebx := Handle;
Regs.eax:=$4000;
RealIntr($21, Regs);
FileTruncate:=(regs.realflags and carryflag)=0;
if Size > high (longint) then
FileTruncate := false
else
begin
FileSeek(Handle,Size,0);
Regs.realecx := 0;
Regs.realedx := tb_offset;
Regs.ds := tb_segment;
Regs.ebx := Handle;
Regs.eax:=$4000;
RealIntr($21, Regs);
FileTruncate:=(regs.realflags and carryflag)=0;
end;
end;

2
rtl/macos/sysutils.pp
View File

@ -154,7 +154,7 @@ begin
*)
end;
Function FileTruncate (Handle,Size: Longint) : boolean;
Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
begin
(* TODO fix

6
rtl/morphos/sysutils.pp
View File

@ -206,11 +206,15 @@ begin
end;
function FileTruncate(Handle, Size: LongInt): Boolean;
function FileTruncate(Handle: THandle; Size: Int64): Boolean;
var
dosResult: LongInt;
begin
FileTruncate:=False;
if Size > high (longint) then exit;
{$WARNING Possible support for 64-bit FS to be checked!}
if (Handle<=0) then exit;
dosResult:=SetFileSize(Handle, Size, OFFSET_BEGINNING);

2
rtl/nds/sysutils.pp
View File

@ -102,7 +102,7 @@ begin
end;
function FileTruncate(Handle, Size: LongInt): Boolean;
function FileTruncate(Handle: THandle; Size: Int64): Boolean;
begin
result := false;
end;

8
rtl/netware/sysutils.pp
View File

@ -145,10 +145,14 @@ begin
_close(Handle);
end;
Function FileTruncate (Handle : THandle; Size: Longint) : boolean;
Function FileTruncate (Handle : THandle; Size: Int64) : boolean;
begin
FileTruncate:=(_chsize(Handle,Size) = 0);
if Size > high (longint) then
FileTruncate := false
{$WARNING Possible support for 64-bit FS to be checked!}
else
FileTruncate:=(_chsize(Handle,Size) = 0);
end;
Function FileLock (Handle,FOffset,FLen : Longint) : Longint;

8
rtl/netwlibc/sysutils.pp
View File

@ -142,9 +142,13 @@ begin
libc.fpclose(Handle);
end;
Function FileTruncate (Handle : THandle; Size: Longint) : boolean;
Function FileTruncate (Handle : THandle; Size: Int64) : boolean;
begin
FileTruncate:=(libc.fpchsize(Handle,Size) = 0);
if Size > high (longint) then
FileTruncate := false
{$WARNING Possible support for 64-bit FS to be checked!}
else
FileTruncate:=(libc.fpchsize(Handle,Size) = 0);
end;
Function FileLock (Handle : THandle; FOffset,FLen : Longint) : Longint;

2
rtl/objpas/sysutils/filutilh.inc
View File

@ -79,7 +79,7 @@ Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
Function FileSeek (Handle : THandle; FOffset, Origin: Longint) : Longint;
Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
Procedure FileClose (Handle : THandle);
Function FileTruncate (Handle : THandle;Size: Longint) : boolean;
Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
Function FileAge (Const FileName : String): Longint;
Function FileExists (Const FileName : String) : Boolean;
Function DirectoryExists (Const Directory : String) : Boolean;

2
rtl/os2/sysutils.pp
View File

@ -557,7 +557,7 @@ begin
DosClose(Handle);
end;
function FileTruncate (Handle: THandle; Size: longint): boolean;
function FileTruncate (Handle: THandle; Size: Int64): boolean;
begin
FileTruncate:=Sys_DosSetFileSizeL(Handle, Size)=0;
FileSeek(Handle, 0, 2);

8
rtl/unix/sysutils.pp
View File

@ -238,10 +238,14 @@ begin
fpclose(Handle);
end;
Function FileTruncate (Handle,Size: Longint) : boolean;
Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
begin
FileTruncate:=fpftruncate(Handle,Size)>=0;
if Size > high (longint) then exit;
FileTruncate := false
{$WARNING Support for 64-bit FS to be added!}
else
FileTruncate:=fpftruncate(Handle,Size)>=0;
end;
Function UnixToWinAge(UnixAge : time_t): Longint;

23
rtl/watcom/sysutils.pp
View File

@ -245,18 +245,23 @@ begin
end;
Function FileTruncate (Handle,Size: Longint) : boolean;
Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
var
regs : trealregs;
begin
FileSeek(Handle,Size,0);
Regs.realecx := 0;
Regs.realedx := tb_offset;
Regs.ds := tb_segment;
Regs.ebx := Handle;
Regs.eax:=$4000;
RealIntr($21, Regs);
FileTruncate:=(regs.realflags and carryflag)=0;
if Size > high (longint) then
FileTruncate := false
else
begin
FileSeek(Handle,Size,0);
Regs.realecx := 0;
Regs.realedx := tb_offset;
Regs.ds := tb_segment;
Regs.ebx := Handle;
Regs.eax:=$4000;
RealIntr($21, Regs);
FileTruncate:=(regs.realflags and carryflag)=0;
end;
end;

10
rtl/win/sysutils.pp
View File

@ -272,11 +272,15 @@ begin
end;
Function FileTruncate (Handle : THandle;Size: Longint) : boolean;
Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
begin
{
Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1;
If Result then
Result:=SetEndOfFile(handle);
}
if FileSeek (Handle, Size, FILE_BEGIN) = Size then
Result:=SetEndOfFile(handle)
else
Result := false;
end;
Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;

9
rtl/wince/sysutils.pp
View File

@ -211,11 +211,12 @@ begin
end;
Function FileTruncate (Handle : THandle;Size: Longint) : boolean;
Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
begin
Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1;
If Result then
Result:=SetEndOfFile(handle);
if FileSeek (Handle, Size, FILE_BEGIN) = Size then
Result:=SetEndOfFile(handle)
else
Result := false;
end;