paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-23 09:49:46 +01: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; end;
function FileTruncate(Handle, Size: LongInt): Boolean; function FileTruncate(Handle: longint; Size: Int64): Boolean;
var var
dosResult: LongInt; dosResult: LongInt;
begin begin
FileTruncate:=False; FileTruncate:=False;
if Size > high (longint) then exit;
{$WARNING Possible support for 64-bit FS to be checked!}
if (Handle<=0) then exit; if (Handle<=0) then exit;
dosResult:=SetFileSize(Handle, Size, OFFSET_BEGINNING); dosResult:=SetFileSize(Handle, Size, OFFSET_BEGINNING);

2
rtl/beos/sysutils.pp
View File

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

8
rtl/emx/sysutils.pp
View File

@ -513,15 +513,19 @@ begin
end; end;
function FileTruncate (Handle, Size: longint): boolean; assembler; function FileTruncate (Handle: THandle; Size: Int64): boolean; assembler;
asm asm
push ebx push ebx
{$IFDEF REGCALL} {$IFDEF REGCALL}
mov ebx, eax mov ebx, eax
{$ELSE REGCALL} {$ELSE REGCALL}
mov ebx, Handle mov ebx, Handle
mov edx, Size
{$ENDIF REGCALL} {$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 mov eax, 7F25h
push ebx push ebx
call syscall call syscall

2
rtl/gba/sysutils.pp
View File

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

23
rtl/go32v2/sysutils.pp
View File

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

2
rtl/macos/sysutils.pp
View File

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

6
rtl/morphos/sysutils.pp
View File

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

2
rtl/nds/sysutils.pp
View File

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

8
rtl/netware/sysutils.pp
View File

@ -145,10 +145,14 @@ begin
_close(Handle); _close(Handle);
end; end;
Function FileTruncate (Handle : THandle; Size: Longint) : boolean; Function FileTruncate (Handle : THandle; Size: Int64) : boolean;
begin 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; end;
Function FileLock (Handle,FOffset,FLen : Longint) : Longint; Function FileLock (Handle,FOffset,FLen : Longint) : Longint;

8
rtl/netwlibc/sysutils.pp
View File

@ -142,9 +142,13 @@ begin
libc.fpclose(Handle); libc.fpclose(Handle);
end; end;
Function FileTruncate (Handle : THandle; Size: Longint) : boolean; Function FileTruncate (Handle : THandle; Size: Int64) : boolean;
begin 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; end;
Function FileLock (Handle : THandle; FOffset,FLen : Longint) : Longint; 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, Origin: Longint) : Longint;
Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64; Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
Procedure FileClose (Handle : THandle); 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 FileAge (Const FileName : String): Longint;
Function FileExists (Const FileName : String) : Boolean; Function FileExists (Const FileName : String) : Boolean;
Function DirectoryExists (Const Directory : String) : Boolean; Function DirectoryExists (Const Directory : String) : Boolean;

2
rtl/os2/sysutils.pp
View File

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

8
rtl/unix/sysutils.pp
View File

@ -238,10 +238,14 @@ begin
fpclose(Handle); fpclose(Handle);
end; end;
Function FileTruncate (Handle,Size: Longint) : boolean; Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
begin 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; end;
Function UnixToWinAge(UnixAge : time_t): Longint; Function UnixToWinAge(UnixAge : time_t): Longint;

23
rtl/watcom/sysutils.pp
View File

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

10
rtl/win/sysutils.pp
View File

@ -272,11 +272,15 @@ begin
end; end;
Function FileTruncate (Handle : THandle;Size: Longint) : boolean; Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
begin begin
{
Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1; 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; end;
Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool; Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;

9
rtl/wince/sysutils.pp
View File

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