paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:49:26 +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 }
{---------------------------------------------------------------------------}
FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
VAR Actual, Buf: LongInt;
VAR Actual: LongInt;
regs : trealregs;
const
CarryFlag = $001;
BEGIN
SetFilePos(Handle,FileSize,0,Actual);
If (Actual = FileSize) Then
Begin
Actual := FileWrite(Handle, Buf, 0,Actual); { Truncate the file }
If (Actual <> -1) Then
regs.realecx:=0;
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
Else
SetFileSize := 103; { File truncate error }
@ -173,7 +181,10 @@ END;
{
$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
Revision 1.5 2000/03/20 19:19:44 pierre