+ FileTruncate allows 64-bit parameter

git-svn-id: trunk@6727 -

rtl/amiga/sysutils.pp

@@ -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);

rtl/beos/sysutils.pp

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

rtl/emx/sysutils.pp

@@ -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

rtl/gba/sysutils.pp

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

rtl/go32v2/sysutils.pp

@@ -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;
 
 

rtl/macos/sysutils.pp

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

rtl/morphos/sysutils.pp

@@ -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);

rtl/nds/sysutils.pp

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

rtl/netware/sysutils.pp

@@ -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;

rtl/netwlibc/sysutils.pp

@@ -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;

rtl/objpas/sysutils/filutilh.inc

@@ -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;

rtl/os2/sysutils.pp

@@ -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);

rtl/unix/sysutils.pp

@@ -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;

rtl/watcom/sysutils.pp

@@ -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;
 
 

rtl/win/sysutils.pp

@@ -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;

rtl/wince/sysutils.pp

@@ -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;