mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 19:31:37 +01:00
448 lines
8.7 KiB
PHP
448 lines
8.7 KiB
PHP
{
|
||
$Id$
|
||
This file is part of the Free Pascal Run time library.
|
||
Copyright (c) 1993,97 by the Free Pascal development team
|
||
|
||
See the file COPYING.FPC, included in this distribution,
|
||
for details about the copyright.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WithOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||
|
||
**********************************************************************}
|
||
|
||
{****************************************************************************
|
||
subroutines For UnTyped File handling
|
||
****************************************************************************}
|
||
|
||
type
|
||
UnTypedFile=File;
|
||
|
||
Procedure Assign(var f:File;const Name:string);
|
||
{
|
||
Assign Name to file f so it can be used with the file routines
|
||
}
|
||
Begin
|
||
FillChar(f,SizeOf(FileRec),0);
|
||
FileRec(f).Handle:=UnusedHandle;
|
||
FileRec(f).mode:=fmClosed;
|
||
Move(Name[1],FileRec(f).Name,Length(Name));
|
||
End;
|
||
|
||
|
||
Procedure assign(var f:File;p:pchar);
|
||
{
|
||
Assign Name to file f so it can be used with the file routines
|
||
}
|
||
begin
|
||
Assign(f,StrPas(p));
|
||
end;
|
||
|
||
|
||
Procedure assign(var f:File;c:char);
|
||
{
|
||
Assign Name to file f so it can be used with the file routines
|
||
}
|
||
begin
|
||
Assign(f,string(c));
|
||
end;
|
||
|
||
|
||
Procedure Rewrite(var f:File;l:Longint);[IOCheck];
|
||
{
|
||
Create file f with recordsize of l
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
Case FileRec(f).mode Of
|
||
fmInOut,fmInput,fmOutput : Close(f);
|
||
fmClosed : ;
|
||
else
|
||
Begin
|
||
InOutRes:=102;
|
||
exit;
|
||
End;
|
||
End;
|
||
If l=0 Then
|
||
InOutRes:=2
|
||
else
|
||
Begin
|
||
Do_Open(f,PChar(@FileRec(f).Name),$101);
|
||
FileRec(f).RecSize:=l;
|
||
End;
|
||
End;
|
||
|
||
|
||
Procedure Reset(var f:File;l:Longint);[IOCheck];
|
||
{
|
||
Open file f with recordsize of l and filemode
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
Exit;
|
||
Case FileRec(f).mode Of
|
||
fmInOut,fmInput,fmOutput : Close(f);
|
||
fmClosed : ;
|
||
else
|
||
Begin
|
||
InOutRes:=102;
|
||
exit;
|
||
End;
|
||
End;
|
||
If l=0 Then
|
||
InOutRes:=2
|
||
else
|
||
Begin
|
||
Do_Open(f,PChar(@FileRec(f).Name),Filemode);
|
||
FileRec(f).RecSize:=l;
|
||
End;
|
||
End;
|
||
|
||
|
||
Procedure Rewrite(Var f:File);[IOCheck];
|
||
{
|
||
Create file with (default) 128 byte records
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
Rewrite(f,128);
|
||
End;
|
||
|
||
|
||
Procedure Reset(Var f:File);[IOCheck];
|
||
{
|
||
Open file with (default) 128 byte records
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
Reset(f,128);
|
||
End;
|
||
|
||
|
||
Procedure BlockWrite(Var f:File;Var Buf;Count:Longint;var Result:Longint);[IOCheck];
|
||
{
|
||
Write Count records from Buf to file f, return written records in result
|
||
}
|
||
Begin
|
||
Result:=0;
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
Result:=Do_Write(FileRec(f).Handle,Longint(@Buf),Count*FileRec(f).RecSize) div FileRec(f).RecSize;
|
||
End;
|
||
|
||
|
||
Procedure BlockWrite(Var f:File;Var Buf;Count:Word;var Result:Word);[IOCheck];
|
||
{
|
||
Write Count records from Buf to file f, return written records in Result
|
||
}
|
||
var
|
||
l : longint;
|
||
Begin
|
||
BlockWrite(f,Buf,Count,l);
|
||
Result:=l;
|
||
End;
|
||
|
||
|
||
Procedure BlockWrite(Var f:File;Var Buf;Count:Word;var Result:Integer);[IOCheck];
|
||
{
|
||
Write Count records from Buf to file f, return written records in Result
|
||
}
|
||
var
|
||
l : longint;
|
||
Begin
|
||
BlockWrite(f,Buf,Count,l);
|
||
Result:=l;
|
||
End;
|
||
|
||
|
||
Procedure BlockWrite(Var f:File;Var Buf;Count:Longint);[IOCheck];
|
||
{
|
||
Write Count records from Buf to file f, if none a Read and Count>0 then
|
||
InOutRes is set
|
||
}
|
||
var
|
||
Result : Longint;
|
||
Begin
|
||
BlockWrite(f,Buf,Count,Result);
|
||
If (Result=0) and (Count>0) Then
|
||
InOutRes:=101;
|
||
End;
|
||
|
||
|
||
Procedure BlockRead(var f:File;var Buf;Count:Longint;var Result:Longint);[IOCheck];
|
||
{
|
||
Read Count records from file f ro Buf, return nu<EFBFBD>ber of read records in
|
||
Result
|
||
}
|
||
Begin
|
||
Result:=0;
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmInput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),count*FileRec(f).RecSize) div FileRec(f).RecSize;
|
||
End;
|
||
|
||
|
||
Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Word);[IOCheck];
|
||
{
|
||
Read Count records from file f to Buf, return number of read records in
|
||
Result
|
||
}
|
||
var
|
||
l : longint;
|
||
Begin
|
||
BlockRead(f,Buf,Count,l);
|
||
Result:=l;
|
||
End;
|
||
|
||
|
||
Procedure BlockRead(var f:File;var Buf;count:Word;var Result:Integer);[IOCheck];
|
||
{
|
||
Read Count records from file f to Buf, return number of read records in
|
||
Result
|
||
}
|
||
var
|
||
l : longint;
|
||
Begin
|
||
BlockRead(f,Buf,Count,l);
|
||
Result:=l;
|
||
End;
|
||
|
||
|
||
Procedure BlockRead(Var f:File;Var Buf;Count:Longint);[IOCheck];
|
||
{
|
||
Read Count records from file f to Buf, if none are read and Count>0 then
|
||
InOutRes is set
|
||
}
|
||
var
|
||
Result : Longint;
|
||
Begin
|
||
BlockRead(f,Buf,Count,Result);
|
||
If (Result=0) and (Count>0) Then
|
||
InOutRes:=100;
|
||
End;
|
||
|
||
|
||
Function FilePos(var f:File):Longint;[IOCheck];
|
||
{
|
||
Return current Position In file f in records
|
||
}
|
||
Begin
|
||
FilePos:=0;
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmInput,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
FilePos:=Do_FilePos(FileRec(f).Handle) div FileRec(f).RecSize;
|
||
End;
|
||
|
||
|
||
Function FileSize(var f:File):Longint;[IOCheck];
|
||
{
|
||
Return the size of file f in records
|
||
}
|
||
Begin
|
||
FileSize:=0;
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmInput,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
if (FileRec(f).RecSize>0) then
|
||
FileSize:=Do_FileSize(FileRec(f).Handle) div FileRec(f).RecSize;
|
||
End;
|
||
|
||
|
||
Function Eof(var f:File):Boolean;[IOCheck];
|
||
{
|
||
Return True if we're at the end of the file f, else False is returned
|
||
}
|
||
Begin
|
||
Eof:=false;
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmInput,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
{Can't use do_ routines because we need record support}
|
||
Eof:=(FileSize(f)<=FilePos(f));
|
||
End;
|
||
|
||
|
||
Procedure Seek(var f:File;Pos:Longint);[IOCheck];
|
||
{
|
||
Goto record Pos in file f
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmInput,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
Do_Seek(FileRec(f).Handle,Pos*FileRec(f).RecSize);
|
||
End;
|
||
|
||
|
||
Procedure Truncate(Var f:File);[IOCheck];
|
||
{
|
||
Truncate/Cut file f at the current record Position
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
Do_Truncate(FileRec(f).Handle,FilePos(f)*FileRec(f).RecSize);
|
||
End;
|
||
|
||
|
||
Procedure Close(var f:File);[IOCheck];
|
||
{
|
||
Close file f
|
||
}
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
case FileRec(f).Mode of
|
||
fmInOut,fmInput,fmOutput : ;
|
||
else
|
||
begin
|
||
InOutRes:=103;
|
||
exit;
|
||
end;
|
||
end;
|
||
FileRec(f).mode:=fmClosed;
|
||
if FileRec(f).Handle>4 then
|
||
Do_Close(FileRec(f).Handle);
|
||
End;
|
||
|
||
|
||
Procedure Erase(var f : File);[IOCheck];
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
If FileRec(f).mode=fmClosed Then
|
||
Do_Erase(PChar(@FileRec(f).Name));
|
||
End;
|
||
|
||
|
||
Procedure Rename(var f : File;p:pchar);[IOCheck];
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
If FileRec(f).mode=fmClosed Then
|
||
Begin
|
||
Do_Rename(PChar(@FileRec(f).Name),p);
|
||
Move(p^,FileRec(f).Name,StrLen(p)+1);
|
||
End;
|
||
End;
|
||
|
||
|
||
Procedure Rename(var f : File;const s : string);[IOCheck];
|
||
var
|
||
p : array[0..255] Of Char;
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
Move(s[1],p,Length(s));
|
||
p[Length(s)]:=#0;
|
||
Rename(f,Pchar(@p));
|
||
End;
|
||
|
||
|
||
Procedure Rename(var f : File;c : char);[IOCheck];
|
||
var
|
||
p : array[0..1] Of Char;
|
||
Begin
|
||
If InOutRes <> 0 then
|
||
exit;
|
||
p[0]:=c;
|
||
p[1]:=#0;
|
||
Rename(f,Pchar(@p));
|
||
End;
|
||
|
||
{
|
||
$Log$
|
||
Revision 1.10 1998-11-29 23:10:12 peter
|
||
* also check fmInput,fmOutput
|
||
|
||
Revision 1.9 1998/11/29 22:28:11 peter
|
||
+ io-error 103 added
|
||
|
||
Revision 1.8 1998/09/17 16:34:16 peter
|
||
* new eof,eoln,seekeoln,seekeof
|
||
* speed upgrade for read_string
|
||
* inoutres 104/105 updates for read_* and write_*
|
||
|
||
Revision 1.7 1998/09/04 18:16:12 peter
|
||
* uniform filerec/textrec (with recsize:longint and name:0..255)
|
||
|
||
Revision 1.6 1998/07/19 19:55:32 michael
|
||
+ fixed rename. Changed p to p^
|
||
|
||
Revision 1.5 1998/07/02 12:15:39 carl
|
||
+ Each IOCheck routine now checks for InOures before executing, like TP
|
||
|
||
Revision 1.4 1998/06/23 16:57:16 peter
|
||
* fixed the filesize() problems under linux and filerec.size=0 error
|
||
|
||
Revision 1.3 1998/05/21 19:30:56 peter
|
||
* objects compiles for linux
|
||
+ assign(pchar), assign(char), rename(pchar), rename(char)
|
||
* fixed read_text_as_array
|
||
+ read_text_as_pchar which was not yet in the rtl
|
||
|
||
Revision 1.2 1998/05/12 10:42:44 peter
|
||
* moved getopts to inc/, all supported OS's need argc,argv exported
|
||
+ strpas, strlen are now exported in the systemunit
|
||
* removed logs
|
||
* removed $ifdef ver_above
|
||
|
||
}
|