paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 09:39:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed truncate

Browse Source
This commit is contained in:
peter 2000-06-30 22:16:19 +00:00
parent 757f68ec58
commit 98ec034eb2
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/go32v2/objinc.inc
View File

@ -156,13 +156,21 @@ End;
{ SetFileSize -> Platforms DOS - Not Checked } { SetFileSize -> Platforms DOS - Not Checked }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word; FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
VAR Actual, Buf: LongInt; VAR Actual: LongInt;
regs : trealregs;
const
CarryFlag = $001;
BEGIN BEGIN
SetFilePos(Handle,FileSize,0,Actual); SetFilePos(Handle,FileSize,0,Actual);
If (Actual = FileSize) Then If (Actual = FileSize) Then
Begin Begin
Actual := FileWrite(Handle, Buf, 0,Actual); { Truncate the file } regs.realecx:=0;
If (Actual <> -1) Then regs.realedx:=tb mod 16;
regs.realds:=tb div 16;
regs.realebx:=handle;
regs.realeax:=$4000;
sysrealintr($21,regs);
if (regs.RealFlags and CarryFlag = 0) then { no error }
SetFileSize := 0 SetFileSize := 0
Else Else
SetFileSize := 103; { File truncate error } SetFileSize := 103; { File truncate error }
@ -173,7 +181,10 @@ END;
{ {
$Log$ $Log$
Revision 1.6 2000-05-30 06:45:53 marco Revision 1.7 2000-06-30 22:16:19 peter
* fixed truncate
Revision 1.6 2000/05/30 06:45:53 marco
* fixed in line 164 pointer(@buf) to buf * fixed in line 164 pointer(@buf) to buf
Revision 1.5 2000/03/20 19:19:44 pierre Revision 1.5 2000/03/20 19:19:44 pierre