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

* AllowDirectorySeparators and AllowDriveSeparators typed constants

Browse Source 
added to allow customization of path and directory parsing in the rtl
  * Use the new sets instead of the hardcoded / and \

git-svn-id: trunk@10105 -
This commit is contained in:
peter 2008-01-29 23:04:56 +00:00
parent 3d319a99b8
commit f4f3ae84d0
49 changed files with 244 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/amiga/dos.pp
View File

@ -122,8 +122,8 @@ procedure Amiga2DateStamp(Date : LongInt; var TotalDays,Minutes,Ticks: longint);
{ Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
{ Taken from SWAG and modified to work with the Amiga format - CEC }
var
LocalDate : LongInt;
Done : Boolean;
LocalDate : LongInt;
Done : Boolean;
TotDays : Integer;
Y: Word;
H: Word;
@ -183,7 +183,7 @@ begin
end;
function dosSetFileDate(name: string; p : PDateStamp): Boolean;
var
var
buffer : array[0..255] of Char;
begin
move(name[1],buffer,length(name));
@ -448,7 +448,7 @@ begin
DosError:= 0;
LastDosExitCode:=0;
tmpPath:=PathConv(Path)+#0+ComLine+#0; // hacky... :)
{ Here we must first check if the command we wish to execute }
{ actually exists, because this is NOT handled by the }
{ _SystemTagList call (program will abort!!) }
@ -726,8 +726,7 @@ begin
DosError:=0;
FTime := 0;
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
DoDirSeparators(Str);
FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then begin
New(FInfo);
@ -758,8 +757,7 @@ end;
Begin
new(DateStamp);
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
DoDirSeparators(str);
{ Check first of all, if file exists }
FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then
@ -791,8 +789,7 @@ begin
flags:=0;
New(info);
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
DoDirSeparators(str);
{ open with shared lock to check if file exists }
MyLock:=dosLock(Str,SHARED_LOCK);
if MyLock <> 0 then
@ -853,7 +850,7 @@ end;
--- Environment ---
******************************************************************************}
var
var
strofpaths : string;
function getpathstring: string;

5
rtl/amiga/system.pp
View File

@ -35,7 +35,10 @@ const
LFNSupport = True;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
maxExitCode = 255;
MaxPathLen = 256;
AllFilesMask = '*';
@ -363,7 +366,7 @@ end;
begin
IsConsole := TRUE;
IsLibrary := FALSE;
SysResetFPU;
SysResetFPU;
if not(IsLibrary) then
SysInitFPU;
StackLength := CheckInitialStkLen(InitialStkLen);

21
rtl/atari/system.pas
View File

@ -41,7 +41,10 @@ const
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false;
maxExitCode = 255;
MaxPathLen = 255;
@ -284,13 +287,13 @@ end ['D0'];
Low Level File Routines
****************************************************************************}
procedure AllowSlash(p:pchar);
procedure DoDirSeparators(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator;
end;
@ -310,7 +313,7 @@ end;
procedure do_erase(p : pchar);
begin
AllowSlash(p);
DoDirSeparators(p);
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp) { save regs }
@ -332,8 +335,8 @@ end;
procedure do_rename(p1,p2 : pchar);
begin
AllowSlash(p1);
AllowSlash(p2);
DoDirSeparators(p1);
DoDirSeparators(p2);
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
@ -502,7 +505,7 @@ var
i : word;
oflags: longint;
begin
AllowSlash(p);
DoDirSeparators(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin
@ -625,7 +628,7 @@ var
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer));
DoDirSeparators(pchar(@buffer));
c:=word(func);
asm
move.l d2,d6 { save d2 }
@ -702,8 +705,8 @@ begin
i:=0;
while (temp[i]<>#0) do
begin
if temp[i]='/' then
temp[i]:='\';
if temp[i] in AllowDirectorySeparators then
temp[i]:=DirectorySeparator;
dir[i+3]:=temp[i];
inc(i);
end;

3
rtl/embedded/system.pp
View File

@ -35,7 +35,10 @@ const
LFNSupport = true;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ':';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined below! }
maxExitCode = 255;
MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin

7
rtl/emx/dos.pas
View File

@ -180,8 +180,7 @@ begin
else
begin
{ allow slash as backslash }
for i:=1 to length(dirlist) do
if dirlist[i]='/' then dirlist[i]:='\';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
@ -195,8 +194,8 @@ begin
dirlist:='';
end;
if (newdir<>'') and
not (newdir[length(newdir)] in ['\',':']) then
newdir:=newdir+'\';
not (newdir[length(newdir)] in AllowDirectorySeparators+AllowDriveSeparators) then
newdir:=newdir+DirectorySeparator;
if CheckFile (NewDir + Path + #0) then
NewDir := NewDir + Path
else

14
rtl/emx/sysdir.inc
View File

@ -27,7 +27,7 @@ var buffer:array[0..255] of char;
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
allowslash(Pchar(@buffer));
DoDirSeparators(Pchar(@buffer));
asm
leal buffer,%edx
movb func,%ah
@ -51,7 +51,7 @@ begin
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
allowslash(Pchar(@buffer));
DoDirSeparators(Pchar(@buffer));
Rc := DosCreateDir(buffer,nil);
if Rc <> 0 then
begin
@ -81,7 +81,7 @@ begin
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
allowslash(Pchar(@buffer));
DoDirSeparators(Pchar(@buffer));
Rc := DosDeleteDir(buffer);
if Rc <> 0 then
begin
@ -123,7 +123,7 @@ begin
begin
Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer));
DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
begin
@ -136,7 +136,7 @@ begin
begin
Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer));
DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
begin
@ -210,8 +210,8 @@ begin
while (dir[i]<>#0) do
begin
{ convert path name to DOS }
if dir[i]='/' then
dir[i]:='\';
if dir[i] in AllowDirectorySeparators then
dir[i]:=DirectorySeparator;
dir[0]:=char(i);
inc(i);
end;

18
rtl/emx/sysfile.inc
View File

@ -19,16 +19,6 @@
****************************************************************************}
procedure allowslash(p:Pchar);
{Allow slash as backslash.}
var i:longint;
begin
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close (H: THandle);
@ -53,7 +43,7 @@ end;
procedure do_erase(p:Pchar);
begin
allowslash(p);
DoDirSeparators(p);
asm
movl P,%edx
movb $0x41,%ah
@ -67,8 +57,8 @@ end;
procedure do_rename(p1,p2:Pchar);
begin
allowslash(p1);
allowslash(p2);
DoDirSeparators(p1);
DoDirSeparators(p2);
asm
movl P1, %edx
movl P2, %edi
@ -277,7 +267,7 @@ procedure do_open(var f;p:pchar;flags:longint);
var Action: cardinal;
begin
allowslash(p);
DoDirSeparators(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin

3
rtl/emx/system.pas
View File

@ -29,7 +29,10 @@ const
{ LFNSupport is defined separately below!!! }
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255;
MaxPathLen = 256;

3
rtl/gba/system.pp
View File

@ -35,7 +35,10 @@ const
CtrlZMarksEOF: boolean = false;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false;
maxExitCode = 255;
MaxPathLen = 255;

14
rtl/go32v2/dos.pp
View File

@ -217,9 +217,7 @@ begin
{ create path }
p:=path;
{ allow slash as backslash }
for i:=1 to length(p) do
if p[i]='/' then
p[i]:='\';
DoDirSeparators(p);
if LFNSupport then
GetShortName(p);
{ create buffer }
@ -232,7 +230,6 @@ begin
paste_to_dos(envstr(i),false,1);
{the behaviour is still suboptimal because variable COMMAND is stripped out}
paste_to_dos(chr(0),false,1); { adds a double zero at the end }
{ allow slash as backslash }
la_p:=current_dos_buffer_pos;
paste_to_dos(p,false,0);
la_c:=current_dos_buffer_pos;
@ -472,8 +469,7 @@ var
w : LFNSearchRec;
begin
{ allow slash as backslash }
for i:=0 to strlen(path) do
if path[i]='/' then path[i]:='\';
DoDirSeparators(path);
dosregs.si:=1; { use ms-dos time }
{ don't include the label if not asked for it, needed for network drives }
if attr=$8 then
@ -571,8 +567,7 @@ var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(path) do
if path[i]='/' then path[i]:='\';
DoDirSeparators(path);
copytodos(f,sizeof(searchrec));
dosregs.edx:=tb_offset;
dosregs.ds:=tb_segment;
@ -683,8 +678,7 @@ begin
else
begin
{ allow slash as backslash }
for i:=1 to length(dirlist) do
if dirlist[i]='/' then dirlist[i]:='\';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then

2
rtl/go32v2/emu387.pp
View File

@ -187,7 +187,7 @@ begin
if length(cp)=0 then
begin
for i:=length(prog_name) downto 1 do
if (prog_name[i]='\') or (prog_name[i]='/') then
if prog_name[i] in AllowDirectorySeparators then
break;
if i>1 then
cp:=copy(prog_name,1,i);

6
rtl/go32v2/sysdir.inc
View File

@ -25,7 +25,7 @@ var
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer));
DoDirSeparators(pchar(@buffer));
{ True DOS does not like backslashes at end
Win95 DOS accepts this !!
but "\" and "c:\" should still be kept and accepted hopefully PM }
@ -118,8 +118,8 @@ begin
i:=0;
while (temp[i]<>#0) do
begin
if temp[i]='/' then
temp[i]:='\';
if temp[i] in AllowDirectorySeparators then
temp[i]:=DirectorySeparator;
dir[i+4]:=temp[i];
inc(i);
end;

17
rtl/go32v2/sysfile.inc
View File

@ -29,15 +29,6 @@
Low level File Routines
****************************************************************************}
procedure AllowSlash(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close(handle : thandle);
var
regs : trealregs;
@ -67,7 +58,7 @@ procedure do_erase(p : pchar);
var
regs : trealregs;
begin
AllowSlash(p);
DoDirSeparators(p);
syscopytodos(longint(p),strlen(p)+1);
regs.realedx:=tb_offset;
regs.realds:=tb_segment;
@ -87,8 +78,8 @@ procedure do_rename(p1,p2 : pchar);
var
regs : trealregs;
begin
AllowSlash(p1);
AllowSlash(p2);
DoDirSeparators(p1);
DoDirSeparators(p2);
if strlen(p1)+strlen(p2)+3>tb_size then
HandleError(217);
sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
@ -301,7 +292,7 @@ var
regs : trealregs;
action : longint;
begin
AllowSlash(p);
DoDirSeparators(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin

3
rtl/go32v2/system.pp
View File

@ -39,7 +39,10 @@ const
{ LFNSupport is a variable here, defined below!!! }
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255;
MaxPathLen = 256;

29
rtl/inc/dos.inc
View File

@ -16,9 +16,14 @@
**********************************************************************}
(* Everywhere the same now, but prepared for potential difference. *)
const
ExtensionSeparator = '.';
procedure DoDirSeparators(var p:shortstring);
var
i : longint;
begin
for i:=1 to length(p) do
if p[i] in AllowDirectorySeparators then
p[i]:=DirectorySeparator;
end;
{$IFNDEF HAS_DOSEXITCODE}
threadvar
@ -219,18 +224,8 @@ Procedure FSplit (Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: Ex
var
DirEnd, ExtStart: Longint;
begin
if DirectorySeparator = '/' then
{ allow backslash as slash }
for DirEnd := 1 to Length (Path) do
begin
if Path [DirEnd] = '\' then Path [DirEnd] := DirectorySeparator
end
else
if DirectorySeparator = '\' then
{ allow slash as backslash }
for DirEnd := 1 to Length (Path) do
if Path [DirEnd] = '/' then Path [DirEnd] := DirectorySeparator;
{ allow slash and backslash }
DoDirSeparators(Path);
{ Find the first DirectorySeparator or DriveSeparator from the end. }
DirEnd := Length (Path);
{ Avoid problems with platforms having DriveSeparator = DirectorySeparator. }
@ -239,8 +234,8 @@ begin
Dec (DirEnd)
else
while (DirEnd > 0) and
(Path [DirEnd] <> DirectorySeparator) and
(Path [DirEnd] <> DriveSeparator) do
(Path [DirEnd] <> DirectorySeparator) and
(Path [DirEnd] <> DriveSeparator) do
Dec (DirEnd);
{ The first "extension" should be returned if LFN }

2
rtl/inc/exeinfo.pp
View File

@ -1069,7 +1069,7 @@ begin
end;
{ executable dir }
i:=length(e.filename);
while (i>0) and not(e.filename[i] in ['/','\']) do
while (i>0) and not(e.filename[i] in AllowDirectorySeparators) do
dec(i);
if i>0 then
begin

18
rtl/inc/fexpand.inc
View File

@ -127,21 +127,9 @@ begin
(* Allow both '/' and '\' as directory separators *)
(* by converting all to the native one. *)
{$warnings off}
if DirectorySeparator = '\' then
{Allow slash as backslash}
begin
for I := 1 to Length (Pa) do
if Pa [I] = '/' then
Pa [I] := '\'
end
else
if DirectorySeparator = '/' then
{Allow backslash as slash}
begin
for I := 1 to Length (Pa) do
if Pa [I] = '\' then
Pa [I] := '/';
end;
for I := 1 to Length (Pa) do
if Pa [I] in AllowDirectorySeparators then
Pa [I] := DirectorySeparator;
{$warnings on}
(* PathStart is amount of characters to strip to get beginning *)

21
rtl/inc/system.inc
View File

@ -92,7 +92,7 @@ function do_isdevice(handle:thandle):boolean;forward;
****************************************************************************}
{$ifdef FPC_USE_LIBC}
{ Under Haiku, bcopy cause a problem when searching for include file
{ Under Haiku, bcopy cause a problem when searching for include file
in the compiler. So, we use the internal implementation for now
under BeOS and Haiku. }
{$ifndef BEOS}
@ -1247,6 +1247,25 @@ end;
File Handling
*****************************************************************************}
{ Allow slash and backslash as separators }
procedure DoDirSeparators(p:Pchar);
var
i : longint;
begin
for i:=0 to strlen(p) do
if p[i] in AllowDirectorySeparators then
p[i]:=DirectorySeparator;
end;
procedure DoDirSeparators(var p:shortstring);
var
i : longint;
begin
for i:=1 to length(p) do
if p[i] in AllowDirectorySeparators then
p[i]:=DirectorySeparator;
end;
{ OS dependent low level file functions }
{$ifdef FPC_HAS_FEATURE_FILEIO}
{$i sysfile.inc}

6
rtl/macos/macutils.inc
View File

@ -213,7 +213,7 @@ end;
if path[oldPos] = '.' then
if (oldpos + 1 <= oldlen) and (path[oldPos + 1] = '.') then
begin
if (oldpos + 2 > oldlen) or (path[oldPos + 2] in ['/', '\']) then
if (oldpos + 2 > oldlen) or (path[oldPos + 2] in AllowDirectorySeparators) then
begin
{It is "../" or ".." translates to ":" }
if newPos = maxPos then
@ -226,7 +226,7 @@ end;
continue; {Start over again}
end;
end
else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in ['/', '\']) then
else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in AllowDirectorySeparators) then
begin
{It is "./" or "." ignor it }
oldPos := oldPos + 2;
@ -234,7 +234,7 @@ end;
end;
{Collect file or dir name}
while (oldpos <= oldlen) and not (path[oldPos] in ['/', '\']) do
while (oldpos <= oldlen) and not (path[oldPos] in AllowDirectorySeparators) do
begin
if newPos = maxPos then
begin {Shouldn't actually happen, but..}

7
rtl/macos/system.pp
View File

@ -24,14 +24,17 @@ const
LFNSupport = true;
DirectorySeparator = ':';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ','; {Is used in MPW and OzTeX}
AllowDirectorySeparators : set of char = [':'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false;
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
maxExitCode = 65535;
MaxPathLen = 256;
AllFilesMask = '*';
const
{ Default filehandles }
UnusedHandle : Longint = -1;

19
rtl/morphos/dos.pp
View File

@ -122,8 +122,8 @@ procedure Amiga2DateStamp(Date : LongInt; var TotalDays,Minutes,Ticks: longint);
{ Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
{ Taken from SWAG and modified to work with the Amiga format - CEC }
var
LocalDate : LongInt;
Done : Boolean;
LocalDate : LongInt;
Done : Boolean;
TotDays : Integer;
Y: Word;
H: Word;
@ -183,7 +183,7 @@ begin
end;
function dosSetFileDate(name: string; p : PDateStamp): Boolean;
var
var
buffer : array[0..255] of Char;
begin
move(name[1],buffer,length(name));
@ -448,7 +448,7 @@ begin
DosError:= 0;
LastDosExitCode:=0;
tmpPath:=PathConv(Path)+#0+ComLine+#0; // hacky... :)
{ Here we must first check if the command we wish to execute }
{ actually exists, because this is NOT handled by the }
{ _SystemTagList call (program will abort!!) }
@ -727,8 +727,7 @@ begin
DosError:=0;
FTime := 0;
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
DoDirSeparators(str);
FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then begin
New(FInfo);
@ -759,8 +758,7 @@ end;
Begin
new(DateStamp);
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
DoDirSeparators(str);
{ Check first of all, if file exists }
FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then
@ -792,8 +790,7 @@ begin
flags:=0;
New(info);
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
DoDirSeparators(str);
{ open with shared lock to check if file exists }
MyLock:=dosLock(Str,SHARED_LOCK);
if MyLock <> 0 then
@ -854,7 +851,7 @@ end;
--- Environment ---
******************************************************************************}
var
var
strofpaths : string;
function getpathstring: string;

23
rtl/morphos/system.pp
View File

@ -32,11 +32,14 @@ const
LFNSupport = True;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
maxExitCode = 255;
MaxPathLen = 256;
AllFilesMask = '*';
const
UnusedHandle : LongInt = -1;
StdInputHandle : LongInt = 0;
@ -266,7 +269,7 @@ begin
while tmpbuf[counter]<>#0 do counter+=1;
tmpbuf[0]:=Char(counter-1);
GetArgv0Ambient:=tmpbuf;
{ Append slash,if we're not in root directory of a volume }
{ Append slash,if we're not in root directory of a volume }
if tmpbuf[counter-1]<>':' then GetArgv0Ambient+='/';
end;
end;
@ -276,9 +279,9 @@ begin
if progname<>nil then begin
FillDWord(tmpbuf,256 div 4,0);
counter:=0;
while (progname[counter]<>#0) do begin
tmpbuf[counter+1]:=progname[counter];
counter+=1;
while (progname[counter]<>#0) do begin
tmpbuf[counter+1]:=progname[counter];
counter+=1;
end;
tmpbuf[0]:=Char(counter);
GetArgv0Ambient+=tmpbuf;
@ -309,11 +312,11 @@ var
begin
paramstr:='';
if MOS_ambMsg<>nil then begin
if l=0 then begin
paramstr:=GetArgv0Ambient;
exit;
end else
exit;
if l=0 then begin
paramstr:=GetArgv0Ambient;
exit;
end else
exit;
end;
if l=0 then begin

25
rtl/nds/system.pp
View File

@ -26,7 +26,7 @@ interface
{$i softfpu.pp}
{$undef fpc_softfpu_interface}
function IsARM9(): boolean;
function IsARM9(): boolean;
const
LineEnding = #10;
@ -34,7 +34,10 @@ const
CtrlZMarksEOF: boolean = false;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false;
maxExitCode = 255;
MaxPathLen = 255;
@ -54,7 +57,7 @@ var
argv: PPChar;
envp: PPChar;
errno: integer;
fake_heap_end: ^byte; cvar;
fake_heap_end: ^byte; cvar;
implementation
@ -78,19 +81,19 @@ implementation
{$i ndsbios.inc}
{
NDS CPU detecting function (thanks to 21o6):
{
NDS CPU detecting function (thanks to 21o6):
--------------------------------------------
"You see, the ARM7 can't write to bank A of VRAM, but it doesn't give any
error ... it just doesn't write there... so it's easily determinable what
"You see, the ARM7 can't write to bank A of VRAM, but it doesn't give any
error ... it just doesn't write there... so it's easily determinable what
CPU is running the code"
ARM946E-S processor can handle dsp extensions extensions, but ARM7TDMI does
ARM946E-S processor can handle dsp extensions extensions, but ARM7TDMI does
not. FPC can't retrieve the CPU target at compiling time, so this small
function takes care to check if the code is running on an ARM9 or on an ARM7
CPU. It works on Nintendo DS only, I guess :)
}
function IsARM9(): boolean;
function IsARM9(): boolean;
var
Dummy : pword absolute $06800000;
tmp: word;
@ -163,9 +166,9 @@ begin
{ OS specific startup }
{ Set up signals handlers }
if IsARM9 then
if IsARM9 then
fpc_cpucodeinit;
{ Setup heap }
InitHeap;
SysInitExceptions;

9
rtl/netware/dos.pp
View File

@ -371,8 +371,7 @@ begin
else
begin
{ allow backslash as slash }
for i:=1 to length(dirlist) do
if dirlist[i]='\' then dirlist[i]:='/';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
@ -486,11 +485,7 @@ begin
end;
for i := 1 to length(GetEnv) do
if GetEnv[i] = '\' then
GetEnv[i] := '/';
DoDirSeparators(getenv);
end else
begin

3
rtl/netware/sysdir.inc
View File

@ -70,8 +70,7 @@ begin
begin
Move (P, dir[1], i);
BYTE(dir[0]) := i;
For i := 1 to length (dir) do
if dir[i] = '\' then dir [i] := '/';
DoDirSeparators(dir);
// fix / after volume, the compiler needs that
// normaly root of a volumes is SERVERNAME/SYS:, change that
// to SERVERNAME/SYS:/

6
rtl/netware/system.pp
View File

@ -39,7 +39,10 @@ const
LFNSupport : boolean = false;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255;
MaxPathLen = 256;
@ -216,8 +219,7 @@ begin
paramstr:=strpas(argv[l]);
if l = 0 then // fix nlm path
begin
for l := 1 to length (paramstr) do
if paramstr[l] = '\' then paramstr[l] := '/';
DoDirSeparators(paramstr);
end;
end else
paramstr:='';

9
rtl/netwlibc/dos.pp
View File

@ -380,7 +380,7 @@ begin
end;
f._attr := attr;
p := length (path);
while (p > 0) and (not (path[p] in ['\','/'])) do
while (p > 0) and (not (path[p] in AllowDirectorySeparators)) do
dec (p);
if p > 0 then
begin
@ -472,8 +472,7 @@ begin
else
begin
{ allow backslash as slash }
for i:=1 to length(dirlist) do
if dirlist[i]='\' then dirlist[i]:='/';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
@ -659,9 +658,7 @@ begin
inc (i);
res := GetSearchPathElement (i, isdosPath, @SearchElement[0]);
end;
for i := 1 to length(GetEnv) do
if GetEnv[i] = '\' then
GetEnv[i] := '/';
DoDirSeparators(getenv);
end else
begin
strpcopy(envvar0,envvar);

3
rtl/netwlibc/sysdir.inc
View File

@ -70,8 +70,7 @@ begin
begin
Move (P, dir[1], i);
BYTE(dir[0]) := i;
For i := 1 to length (dir) do
if dir[i] = '\' then dir [i] := '/';
DoDirSeparators(dir);
// fix / after volume, the compiler needs that
// normaly root of a volumes is SERVERNAME/SYS:, change that
// to SERVERNAME/SYS:/

6
rtl/netwlibc/system.pp
View File

@ -45,7 +45,10 @@ const
LFNSupport : boolean = false;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = $ffff;
MaxPathLen = 256;
@ -200,8 +203,7 @@ begin
paramstr:=strpas(argv[l]);
if l = 0 then // fix nlm path
begin
for l := 1 to length (paramstr) do
if paramstr[l] = '\' then paramstr[l] := '/';
DoDirSeparators(paramstr);
end;
end else
paramstr:='';

2
rtl/netwlibc/sysutils.pp
View File

@ -258,7 +258,7 @@ begin
end;
Rslt.FindData._attr := attr;
p := length (path);
while (p > 0) and (not (path[p] in ['\','/'])) do
while (p > 0) and (not (path[p] in AllowDirectorySeparators)) do
dec (p);
if p > 0 then
begin

47
rtl/objpas/sysutils/fina.inc
View File

@ -26,7 +26,7 @@ var
EndSep : Set of Char;
begin
i := Length(FileName);
EndSep:=DirSeparators+[':','.'];
EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
while (I > 0) and not(FileName[I] in EndSep) do
Dec(I);
if (I = 0) or (FileName[I] <> '.') then
@ -40,7 +40,7 @@ var
EndSep : Set of Char;
begin
i := Length(FileName);
EndSep:=DirSeparators+[':'];
EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (i > 0) and not (FileName[i] in EndSep) do
Dec(i);
If I>0 then
@ -55,10 +55,10 @@ var
EndSep : Set of Char;
begin
I := Length(FileName);
EndSep:=DirSeparators+[':'];
EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (I > 0) and not (FileName[I] in EndSep) do
Dec(I);
if (I > 1) and (FileName[I] in DirSeparators) and
if (I > 1) and (FileName[I] in AllowDirectorySeparators) and
not (FileName[I - 1] in EndSep) then
Dec(I);
Result := Copy(FileName, 1, I);
@ -74,13 +74,13 @@ begin
l:=Length(FileName);
if (L<2) then
exit;
If (FileName[2]=':') then
If (FileName[2] in AllowDriveSeparators) then
result:=Copy(FileName,1,2)
else if (FileName[1] in DirSeparators) and
(FileName[2] in DirSeparators) then
else if (FileName[1] in AllowDirectorySeparators) and
(FileName[2] in AllowDirectorySeparators) then
begin
i := 2;
While (i<L) and Not (Filename[i+1] in DirSeparators) do
While (i<L) and Not (Filename[i+1] in AllowDirectorySeparators) do
inc(i);
Result:=Copy(FileName,1,i);
end;
@ -92,7 +92,7 @@ var
EndSep : Set of Char;
begin
I := Length(FileName);
EndSep:=DirSeparators+[':'];
EndSep:=AllowDirectorySeparators+AllowDriveSeparators+[ExtensionSeparator];
while (I > 0) and not (FileName[I] in EndSep) do
Dec(I);
Result := Copy(FileName, I + 1, MaxInt);
@ -104,7 +104,7 @@ var
EndSep : Set of Char;
begin
I := Length(FileName);
EndSep:=DirSeparators+['.', ':'];
EndSep:=AllowDirectorySeparators+AllowDriveSeparators;
while (I > 0) and not (FileName[I] in EndSep) do
Dec(I);
if (I > 0) and (FileName[I] = '.') then
@ -116,7 +116,7 @@ end;
function ExtractShortPathName(Const FileName : String) : String;
begin
{$ifdef MSWINDOWS}
{$ifdef MSWINDOWS}
SetLength(Result,Max_Path);
SetLength(Result,GetShortPathName(PChar(FileName), Pchar(Result),Length(Result)));
{$else}
@ -161,7 +161,7 @@ Var Source, Dest : String;
Sc,Dc,I,J : Longint;
SD,DD : Array[1..MaxDirs] of PChar;
Const OneLevelBack = '..'+PathDelim;
Const OneLevelBack = '..'+DirectorySeparator;
begin
If Uppercase(ExtractFileDrive(BaseName))<>Uppercase(ExtractFileDrive(DestName)) Then
@ -183,7 +183,7 @@ begin
end;
Result:='';
For J:=I to SC do Result:=Result+OneLevelBack;
For J:=I to DC do Result:=Result+DD[J]+PathDelim;
For J:=I to DC do Result:=Result+DD[J]+DirectorySeparator;
Result:=Result+ExtractFileName(DestNAme);
end;
@ -193,8 +193,8 @@ VAr I : longint;
begin
For I:=1 to Length(FileName) do
If FileName[I] in DirSeparators then
FileName[i]:=PathDelim;
If FileName[I] in AllowDirectorySeparators then
FileName[i]:=DirectorySeparator;
end;
@ -210,7 +210,6 @@ end;
Dirs is an array of pchars, pointing to these directory names.
The function returns the number of directories found, or -1
if none were found.
DirName must contain only PathDelim as Directory separator chars.
}
Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint;
@ -222,13 +221,13 @@ begin
Result:=-1;
While I<=Length(DirName) do
begin
If (DirName[i]=PathDelim) and
If (DirName[i] in AllowDirectorySeparators) and
{ avoid error in case last char=pathdelim }
(length(dirname)>i) then
begin
DirName[i]:=#0;
Inc(Result);
Dirs[Result]:=@DirName[I+1];
DirName[i]:=#0;
Inc(Result);
Dirs[Result]:=@DirName[I+1];
end;
Inc(I);
end;
@ -243,8 +242,8 @@ Var
begin
Result:=Path;
l:=Length(Result);
If (L=0) or not(Result[l] in DirSeparators) then
Result:=Result+PathDelim;
If (L=0) or not(Result[l] in AllowDirectorySeparators) then
Result:=Result+DirectorySeparator;
end;
function IncludeTrailingBackslash(Const Path : String) : String;
@ -266,7 +265,7 @@ Var
begin
L:=Length(Path);
If (L>0) and (Path[L] in DirSeparators) then
If (L>0) and (Path[L] in AllowDirectorySeparators) then
Dec(L);
Result:=Copy(Path,1,L);
end;
@ -274,7 +273,7 @@ end;
function IsPathDelimiter(Const Path: string; Index: Integer): Boolean;
begin
Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index] in DirSeparators);
Result:=(Index>0) and (Index<=Length(Path)) and (Path[Index] in AllowDirectorySeparators);
end;
Function GetFileHandle(var f : File):Longint;

4
rtl/objpas/sysutils/finah.inc
View File

@ -20,10 +20,6 @@
System Utilities For Free Pascal
}
Const
DirSeparators : set of char = ['/','\'];
function ChangeFileExt(const FileName, Extension: string): string;
function ExtractFilePath(const FileName: string): string;
function ExtractFileDrive(const FileName: string): string;

12
rtl/os2/sysdir.inc
View File

@ -27,7 +27,7 @@ begin
exit;
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
allowslash(Pchar(@buffer));
DoDirSeparators(Pchar(@buffer));
Rc := DosCreateDir(buffer,nil);
if Rc <> 0 then
begin
@ -47,7 +47,7 @@ begin
exit;
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
allowslash(Pchar(@buffer));
DoDirSeparators(Pchar(@buffer));
Rc := DosDeleteDir(buffer);
if Rc <> 0 then
begin
@ -75,7 +75,7 @@ begin
begin
Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer));
DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
begin
@ -86,7 +86,7 @@ begin
end else begin
Move (S [1], Buffer, Length (S));
Buffer [Length (S)] := #0;
AllowSlash (PChar (@Buffer));
DoDirSeparators (PChar (@Buffer));
RC := DosSetCurrentDir (@Buffer);
if RC <> 0 then
begin
@ -124,8 +124,8 @@ begin
while (dir[i]<>#0) do
begin
{ convert path name to DOS }
if dir[i]='/' then
dir[i]:='\';
if dir[i] in AllowDirectorySeparators then
dir[i]:=DirectorySeparator;
dir[0]:=char(i);
inc(i);
end;

16
rtl/os2/sysfile.inc
View File

@ -19,14 +19,6 @@
****************************************************************************}
procedure allowslash(p:Pchar);
{Allow slash as backslash.}
var i:longint;
begin
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close(h:thandle);
begin
{ Only three standard handles under real OS/2 }
@ -41,14 +33,14 @@ end;
procedure do_erase(p:Pchar);
begin
allowslash(p);
DoDirSeparators(p);
inoutres:=DosDelete(p);
end;
procedure do_rename(p1,p2:Pchar);
begin
allowslash(p1);
allowslash(p2);
DoDirSeparators(p1);
DoDirSeparators(p2);
inoutres:=DosMove(p1, p2);
end;
@ -162,7 +154,7 @@ var
Action, Attrib, OpenFlags, FM: Cardinal;
begin
// convert unix slashes to normal slashes
allowslash(p);
DoDirSeparators(p);
// close first if opened
if ((flags and $10000)=0) then

7
rtl/os2/system.pas
View File

@ -37,12 +37,15 @@ const
{ LFNSupport is defined separately below!!! }
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
MaxExitCode = 65535;
MaxPathLen = 256;
AllFilesMask = '*';
type Tos=(osDOS,osOS2,osDPMI);
const OS_Mode: Tos = osOS2;
@ -93,7 +96,7 @@ procedure WriteUseHighMem (B: boolean);
(* underlying OS/2 version, can be overridden by user - heap is allocated *)
(* for all threads, so the setting isn't declared as a threadvar and *)
(* should be only changed at the beginning of the main thread if needed. *)
property
property
UseHighMem: boolean read ReadUseHighMem write WriteUseHighMem;
(* UseHighMem is provided for compatibility with 2.0.x. *)

3
rtl/palmos/system.pp
View File

@ -27,7 +27,10 @@ const
LFNSupport = false;
DirectorySeparator = '/';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
FileNameCaseSensitive = false;
CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
maxExitCode = 255; {$ERROR TODO: CONFIRM THIS}

5
rtl/symbian/system.pp
View File

@ -32,7 +32,10 @@ const
LFNSupport = true;
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below }
maxExitCode = 65535;
MaxPathLen = 260;
@ -185,7 +188,7 @@ begin
{ if we pass here there was no error }
system_exit;
Result := KErrNone;
end;

7
rtl/unix/sysunixh.inc
View File

@ -28,8 +28,11 @@ const
LineEnding = #10;
LFNSupport = true;
DirectorySeparator = '/';
DriveSeparator = ':';
DriveSeparator = '/';
ExtensionSeparator = '.';
PathSeparator = ':';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [];
{ FileNameCaseSensitive is defined below! }
maxExitCode = 255;
{$ifdef LINUX}
@ -38,7 +41,7 @@ const
MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin
{$endif}
AllFilesMask = '*';
const
UnusedHandle = -1;
StdInputHandle = 0;

13
rtl/watcom/dos.pp
View File

@ -204,9 +204,7 @@ begin
c[0]:=char(length(comline)+2);
{ create path }
p:=path;
for i:=1 to length(p) do
if p[i]='/' then
p[i]:='\';
DoDirSeparators(p);
if LFNSupport then
GetShortName(p);
{ create buffer }
@ -460,8 +458,7 @@ var
w : LFNSearchRec;
begin
{ allow slash as backslash }
for i:=0 to strlen(path) do
if path[i]='/' then path[i]:='\';
DoDirSeparators(path);
dosregs.si:=1; { use ms-dos time }
{ don't include the label if not asked for it, needed for network drives }
if attr=$8 then
@ -540,8 +537,7 @@ var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(path) do
if path[i]='/' then path[i]:='\';
DoDirSeparators(path);
copytodos(f,sizeof(searchrec));
dosregs.edx:=tb_offset;
dosregs.ds:=tb_segment;
@ -653,8 +649,7 @@ begin
else
begin
{ allow slash as backslash }
for i:=1 to length(dirlist) do
if dirlist[i]='/' then dirlist[i]:='\';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then

6
rtl/watcom/sysdir.inc
View File

@ -9,7 +9,7 @@ var
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer));
DoDirSeparators(pchar(@buffer));
{ True DOS does not like backslashes at end
Win95 DOS accepts this !!
but "\" and "c:\" should still be kept and accepted hopefully PM }
@ -102,8 +102,8 @@ begin
i:=0;
while (temp[i]<>#0) do
begin
if temp[i]='/' then
temp[i]:='\';
if temp[i] in AllowDirectorySeparators then
temp[i]:=DirectorySeparator;
dir[i+4]:=temp[i];
inc(i);
end;

17
rtl/watcom/sysfile.inc
View File

@ -13,15 +13,6 @@
Low level File Routines
****************************************************************************}
procedure AllowSlash(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
procedure do_close(handle : longint);
var
regs : trealregs;
@ -50,7 +41,7 @@ procedure do_erase(p : pchar);
var
regs : trealregs;
begin
AllowSlash(p);
DoDirSeparators(p);
syscopytodos(longint(p),strlen(p)+1);
regs.realedx:=tb_offset;
regs.realds:=tb_segment;
@ -69,8 +60,8 @@ procedure do_rename(p1,p2 : pchar);
var
regs : trealregs;
begin
AllowSlash(p1);
AllowSlash(p2);
DoDirSeparators(p1);
DoDirSeparators(p2);
if strlen(p1)+strlen(p2)+3>tb_size then
HandleError(217);
sysseg_move(get_ds,sizeuint(p2),dos_selector,tb,strlen(p2)+1);
@ -282,7 +273,7 @@ var
action : longint;
Avoid6c00 : boolean;
begin
AllowSlash(p);
DoDirSeparators(p);
{ check if Extended Open/Create API is safe to use }
Avoid6c00 := lo(dos_version) < 7;
{ close first if opened }

3
rtl/watcom/system.pp
View File

@ -32,7 +32,10 @@ const
{ LFNSupport is a variable here, defined below!!! }
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 255;
MaxPathLen = 256;

3
rtl/win/dos.pp
View File

@ -554,8 +554,7 @@ begin
else
begin
{ allow slash as backslash }
for i:=1 to length(dirlist) do
if dirlist[i]='/' then dirlist[i]:='\';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then

2
rtl/win/sysdir.inc
View File

@ -27,7 +27,7 @@ var
begin
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer));
DoDirSeparators(pchar(@buffer));
if not aFunc(@buffer) then
begin
errno:=GetLastError;

17
rtl/win/sysfile.inc
View File

@ -18,15 +18,6 @@
Low Level File Routines
*****************************************************************************}
procedure AllowSlash(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i]='/' then p[i]:='\';
end;
function do_isdevice(handle:thandle):boolean;
begin
{$ifndef WINCE}
@ -47,7 +38,7 @@ end;
procedure do_erase(p : pchar);
begin
AllowSlash(p);
DoDirSeparators(p);
if DeleteFile(p)=0 then
Begin
errno:=GetLastError;
@ -63,8 +54,8 @@ end;
procedure do_rename(p1,p2 : pchar);
begin
AllowSlash(p1);
AllowSlash(p2);
DoDirSeparators(p1);
DoDirSeparators(p2);
if MoveFile(p1,p2)=0 then
Begin
errno:=GetLastError;
@ -214,7 +205,7 @@ Var
oflags,cd : longint;
security : TSecurityAttributes;
begin
AllowSlash(p);
DoDirSeparators(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin

4
rtl/win32/system.pp
View File

@ -36,7 +36,11 @@ const
LFNSupport = true;
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 65535;
MaxPathLen = 260;

3
rtl/win64/system.pp
View File

@ -33,7 +33,10 @@ const
LFNSupport = true;
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 65535;
MaxPathLen = 260;

15
rtl/wince/dos.pp
View File

@ -80,7 +80,7 @@ type
Longrec=packed record
lo,hi : word;
end;
Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
var
FatDate, FatTime: WORD;
@ -247,7 +247,7 @@ begin
GetMem(DriveNames[1], 2*SizeOf(WideChar));
DriveNames[1][0]:='\';
DriveNames[1][1]:=#0;
// Other drives are found dinamically
h:=FindFirstFile('\*', @fd);
if h <> 0 then
@ -424,8 +424,7 @@ begin
else
begin
{ allow slash as backslash }
for i:=1 to length(dirlist) do
if dirlist[i]='/' then dirlist[i]:='\';
DoDirSeparators(dirlist);
repeat
p1:=pos(';',dirlist);
if p1<>0 then
@ -487,13 +486,13 @@ var
l : cardinal;
buf: array[0..MaxPathLen] of WideChar;
begin
if filerec(f).name[1] = #0 then
if filerec(f).name[1] = #0 then
begin
doserror:=3;
attr:=0;
end
else
begin
begin
doserror:=0;
AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
l:=GetFileAttributes(buf);
@ -504,7 +503,7 @@ begin
end
else
attr:=l and $ffff;
end;
end;
end;
@ -522,7 +521,7 @@ begin
doserror:=0
else
doserror:=Last2DosError(GetLastError);
end;
end;
end;
{******************************************************************************

3
rtl/wince/system.pp
View File

@ -35,7 +35,10 @@ const
LFNSupport = true;
DirectorySeparator = '\';
DriveSeparator = ':';
ExtensionSeparator = '.';
PathSeparator = ';';
AllowDirectorySeparators : set of char = ['\','/'];
AllowDriveSeparators : set of char = [':'];
{ FileNameCaseSensitive is defined separately below!!! }
maxExitCode = 65535;
MaxPathLen = 260;