mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 04:48:02 +02:00

+ codepage support for textrec/filerec and the above routines * textrec/filerec now store the filename by default using widechar. It is possible to switch back to ansichars using the FPC_ANSI_TEXTFILEREC define. In that case, from now on the filename will always be stored in DefaultFileSystemEncoding * fixed potential buffer overflows and non-null-terminated file names in textrec/filerec + dodirseparators(pwidechar), changed the dodirseparators(pchar/pwidechar) parameters into var-parameters and gave those routines an extra parameter that indicates whether the p(wide)char can be changed in place if necessary or whether a copy must be made first (avoids us having to make all strings always unique everywhere, because they might be changed on some platforms via a pchar) * do_open/do_erase/do_rename got extra boolean parameters indicating whether the passed pchars point to data that can be freely changed (to pass on to dodirseparators() if applicable) * objects.pp: force assign(pchar) to be called, because assign(array[0..255]) cannot choose between pchar and rawbytestring versions (and removing the pchar version means that assign(pchar) will be mapped to assign(shortstring) in {$h-}) * fixed up some routines in other units that depend on the format of the textrec/filerec.name field git-svn-id: branches/cpstrrtl@25137 -
179 lines
4.9 KiB
PHP
179 lines
4.9 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2005 by Free Pascal development team
|
|
|
|
Low level file functions for Nintendo Wii
|
|
Copyright (c) 2011 by Francesco Lombardi
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
|
|
|
|
{****************************************************************************
|
|
Low level File Routines
|
|
All these functions can set InOutRes on errors
|
|
****************************************************************************}
|
|
|
|
{ close a file from the handle value }
|
|
procedure do_close(handle: THandle);
|
|
begin
|
|
if FileIODevice.FileIO.DoClose <> nil then
|
|
FileIODevice.FileIO.DoClose(handle);
|
|
//_fclose (_PFILE(pointer(handle))^);
|
|
end;
|
|
|
|
procedure do_erase(p: pchar; pchangeable: boolean);
|
|
begin
|
|
if FileIODevice.FileIO.DoErase <> nil then
|
|
FileIODevice.FileIO.DoErase(p);
|
|
// _unlink(p);
|
|
end;
|
|
|
|
procedure do_rename(p1, p2: pchar; p1changeable, p2changeable: boolean);
|
|
begin
|
|
// _rename(p1, p2);
|
|
if FileIODevice.FileIO.DoRename <> nil then
|
|
FileIODevice.FileIO.DoRename(p1, p2);
|
|
end;
|
|
|
|
function do_write(h: THandle; addr: pointer; len: longint) : longint;
|
|
begin
|
|
// result := _fwrite(addr, 1, len, _PFILE(pointer(h))^);
|
|
if FileIODevice.FileIO.DoWrite <> nil then
|
|
result := FileIODevice.FileIO.DoWrite(h, addr, len);
|
|
end;
|
|
|
|
function do_read(h: THandle; addr: pointer; len: longint) : longint;
|
|
begin
|
|
// result := _fread(addr, 1, len, _PFILE(pointer(h))^);
|
|
if FileIODevice.FileIO.DoRead <> nil then
|
|
result := FileIODevice.FileIO.DoRead(h, addr, len);
|
|
end;
|
|
|
|
function do_filepos(handle: THandle): longint;
|
|
begin
|
|
// result := _ftell(_PFILE(pointer(handle))^);
|
|
if FileIODevice.FileIO.DoFilePos <> nil then
|
|
result := FileIODevice.FileIO.DoFilePos(handle);
|
|
end;
|
|
|
|
procedure do_seek(handle: THandle; pos: longint);
|
|
begin
|
|
//_fseek(_PFILE(pointer(handle))^, pos, SEEK_SET);
|
|
if FileIODevice.FileIO.DoSeek <> nil then
|
|
FileIODevice.FileIO.DoSeek(handle, pos);
|
|
end;
|
|
|
|
function do_seekend(handle: THandle): longint;
|
|
begin
|
|
// result := _fseek(_PFILE(pointer(handle))^, 0, SEEK_END);
|
|
if FileIODevice.FileIO.DoSeekend <> nil then
|
|
result := FileIODevice.FileIO.DoSeekend(handle);
|
|
end;
|
|
|
|
function do_filesize(handle: THandle): longint;
|
|
begin
|
|
// result := -1;
|
|
if FileIODevice.FileIO.DoFilesize <> nil then
|
|
result := FileIODevice.FileIO.DoFilesize(handle);
|
|
end;
|
|
|
|
{ truncate at a given position }
|
|
procedure do_truncate(handle: THandle; pos: longint);
|
|
begin
|
|
// _ftruncate(_fileno(_PFILE(pointer(handle))^), pos);
|
|
if FileIODevice.FileIO.DoTruncate <> nil then
|
|
FileIODevice.FileIO.DoTruncate(handle, pos);
|
|
end;
|
|
|
|
procedure do_open(var f; p: pchar; flags: longint; pchangeable: boolean);
|
|
begin
|
|
(*
|
|
{ close first if opened }
|
|
if ((flags and $10000) = 0) then
|
|
begin
|
|
case FileRec(f).mode of
|
|
fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
|
|
fmclosed : ;
|
|
else
|
|
begin
|
|
// inoutres:=102; {not assigned}
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
{ reset file Handle }
|
|
FileRec(f).Handle:=UnusedHandle;
|
|
|
|
{ We do the conversion of filemodes here, concentrated on 1 place }
|
|
case (flags and 3) of
|
|
0 : begin
|
|
oflags := 'rb'#0;
|
|
filerec(f).mode := fminput;
|
|
end;
|
|
1 : begin
|
|
if (flags and $1000)=$1000 then
|
|
oflags := 'w+b' else
|
|
oflags := 'wb';
|
|
filerec(f).mode := fmoutput;
|
|
end;
|
|
2 : begin
|
|
if (flags and $1000)=$1000 then
|
|
oflags := 'w+' else
|
|
oflags := 'r+';
|
|
filerec(f).mode := fminout;
|
|
end;
|
|
end;
|
|
{if (flags and $1000)=$1000 then
|
|
oflags:=oflags or (O_CREAT or O_TRUNC)
|
|
else
|
|
if (flags and $100)=$100 then
|
|
oflags:=oflags or (O_APPEND);}
|
|
|
|
{ empty name is special }
|
|
if p[0]=#0 then
|
|
begin
|
|
case FileRec(f).mode of
|
|
fminput: FileRec(f).Handle:=StdInputHandle;
|
|
fminout, { this is set by rewrite }
|
|
fmoutput: FileRec(f).Handle:=StdOutputHandle;
|
|
fmappend:
|
|
begin
|
|
FileRec(f).Handle:=StdOutputHandle;
|
|
FileRec(f).mode:=fmoutput; {fool fmappend}
|
|
end;
|
|
end;
|
|
exit;
|
|
end;
|
|
|
|
{ real open call }
|
|
FileRec(f).Handle := longint(fopen(p, @oflags[1]));//_open(p,oflags,438);
|
|
// errno does not seem to be set on succsess ??
|
|
{
|
|
if FileRec(f).Handle = 0 then
|
|
Errno2Inoutres
|
|
else
|
|
InOutRes := 0;
|
|
}
|
|
*)
|
|
// FileRec(f).Handle := THandle (_fopen(p, @oflags[1]));
|
|
if FileIODevice.FileIO.DoOpen <> nil then
|
|
FileIODevice.FileIO.DoOpen(f, p, flags);
|
|
end;
|
|
|
|
function do_isdevice(handle: THandle): boolean;
|
|
begin
|
|
// result := (_isatty(_fileno(_PFILE(pointer(handle))^)) > 0);
|
|
if FileIODevice.FileIO.DoIsdevice <> nil then
|
|
result := FileIODevice.FileIO.DoIsdevice(handle);
|
|
end;
|
|
|
|
|