mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 13:39:39 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			110 lines
		
	
	
		
			2.6 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
			
		
		
	
	
			110 lines
		
	
	
		
			2.6 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
{ For linux we 'steal' the following from system unit, this way
 | 
						|
  we don't need to change the system unit interface. }
 | 
						|
 | 
						|
Var errno : Longint;
 | 
						|
 | 
						|
{$i sysnr.inc}
 | 
						|
{$i errno.inc}
 | 
						|
{$i sysconst.inc}
 | 
						|
{$i systypes.inc}
 | 
						|
{$i signal.inc}
 | 
						|
{$i syscalls.inc}
 | 
						|
 | 
						|
FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
 | 
						|
 | 
						|
Var LinuxMode : longint;
 | 
						|
    
 | 
						|
BEGIN
 | 
						|
  LinuxMode:=0;
 | 
						|
  if Mode=stCreate then
 | 
						|
  Begin
 | 
						|
     LinuxMode:=Open_Creat;
 | 
						|
     LinuxMode:=LinuxMode or Open_RdWr;
 | 
						|
  end
 | 
						|
  else
 | 
						|
   Begin
 | 
						|
     Case (Mode and 3) of
 | 
						|
      0 : LinuxMode:=LinuxMode or Open_RdOnly;
 | 
						|
      1 : LinuxMode:=LinuxMode or Open_WrOnly;
 | 
						|
      2 : LinuxMode:=LinuxMode or Open_RdWr;
 | 
						|
     end;
 | 
						|
   end;
 | 
						|
  FileOpen:=SYS_Open (pchar(@FileName[0]),LinuxMode,438 {666 octal});
 | 
						|
  If FileOpen=-1 then FileOpen:=0;
 | 
						|
  DosStreamError:=Errno;
 | 
						|
END;
 | 
						|
 | 
						|
FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
 | 
						|
Var BytesMoved: Sw_Word): Word;
 | 
						|
BEGIN
 | 
						|
  BytesMoved:=Sys_read (Handle,Pchar(@BufferArea),BufferLength);
 | 
						|
  DosStreamError:=Errno;
 | 
						|
  FileRead:=Errno;
 | 
						|
END;
 | 
						|
 | 
						|
FUNCTION FileWrite (Handle:  THandle; Var BufferArea; BufferLength: Sw_Word;
 | 
						|
Var BytesMoved: Sw_Word): Word;
 | 
						|
BEGIN
 | 
						|
  BytesMoved:=Sys_Write (Handle,Pchar(@BufferArea),BufferLength);
 | 
						|
  FileWrite:=Errno;
 | 
						|
  DosStreamError:=Errno;
 | 
						|
END;
 | 
						|
 | 
						|
FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
 | 
						|
VAR NewPos: LongInt): Word;
 | 
						|
 | 
						|
BEGIN
 | 
						|
  NewPos:=Sys_LSeek (Handle,Pos,MoveType);
 | 
						|
  SetFilePos:=Errno;
 | 
						|
END;
 | 
						|
 | 
						|
FUNCTION FileClose (Handle: THandle): Word;
 | 
						|
BEGIN
 | 
						|
  Sys_Close (Handle);
 | 
						|
  DosStreamError:=Errno;
 | 
						|
  FileClose := Errno;
 | 
						|
END;
 | 
						|
 | 
						|
FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
 | 
						|
 | 
						|
{$IFNDEF BSD}
 | 
						|
Var sr : syscallregs;
 | 
						|
{$ENDIF}
 | 
						|
{$IFDEF DOSSETFILE1}  
 | 
						|
    Actual, Buf: LongInt;
 | 
						|
{$ENDIF}
 | 
						|
   
 | 
						|
BEGIN
 | 
						|
 {$IFDEF BSD}
 | 
						|
  Do_Syscall(Syscall_Nr_ftruncate,handle,filesize,0); {0 -> offset =64 bit}
 | 
						|
 {$ELSE}
 | 
						|
  sr.reg2:=Handle;
 | 
						|
  sr.reg3:=FileSize;
 | 
						|
  Syscall(syscall_nr_fTruncate,sr);
 | 
						|
 {$ENDIF}
 | 
						|
  If Errno=0 then  
 | 
						|
    SetFileSize:=0
 | 
						|
  else
 | 
						|
    SetFileSize:=103;
 | 
						|
{$IFDEF DOSSETFILE1}  
 | 
						|
   If (Actual = FileSize) Then Begin                  { No position error }
 | 
						|
     Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual);   { Truncate the file }
 | 
						|
     If (Actual <> -1) Then SetFileSize := 0 Else     { No truncate error }
 | 
						|
       SetFileSize := 103;                            { File truncate error }
 | 
						|
   End Else SetFileSize := 103;                       { File truncate error }
 | 
						|
{$ENDIF}   
 | 
						|
END;
 | 
						|
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.2  2000-09-18 13:14:51  marco
 | 
						|
   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
 | 
						|
 | 
						|
  Revision 1.3  2000/09/11 14:05:31  marco
 | 
						|
   * FreeBSD support and removed old signalhandling
 | 
						|
 | 
						|
  Revision 1.2  2000/07/13 11:33:49  michael
 | 
						|
  + removed logs
 | 
						|
 
 | 
						|
}
 |