summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2013-07-04 22:28:37 +0000
committerjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2013-07-04 22:28:37 +0000
commit703e176f36dc415eeb013f3b84c7265f878c455b (patch)
treea1524954d423971421170267686271c8c40fad18
parent91e95a1a064b68fb6bd765e325ee979ea1d6b1d0 (diff)
downloadfpc-703e176f36dc415eeb013f3b84c7265f878c455b.tar.gz
+ added mkdir/chdir/rmdir(rawbytestring) and (unicodestring) to the system unit
* renamed platform-specific pchar versions of those rouines to do_*() and changed them to either rawbytestring or unicodestring depending on the FPCRTL_FILESYSTEM_SINGLE_BYTE_API/FPCRTL_FILESYSTEM_TWO_BYTE_API setting * implemented generic shortstring versions of those routines on top of either rawbytestring or unicodestring depending on the API-kind (in case of the embedded target, if ansistring are not supported they will map directly to shortstring routines instead) * all platform-specific *dir() routines with rawbytestring parameters now receive their parameters in DefaultFileSystemCodePage - removed no longer required ansistring variants from the objpas unit - removed no longer required FPC_SYS_MKDIR etc aliases * factored out empty string and inoutres<>0 checks from platform-specific *dir() routines to generic ones o platform-specific notes: o amiga/morphos: check new pathconv(rawbytestring) function o macos TODO: convert PathArgToFSSpec (and the routines it calls) to rawbytestring o nativent: added SysUnicodeStringToNtStr() function o wii: convert dirio callbacks to use rawbytestring to avoid conversion + test for unicode mk/ch/rm/getdir() git-svn-id: http://svn.freepascal.org/svn/fpc/branches/cpstrrtl@25048 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--rtl/amiga/sysdir.inc42
-rw-r--r--rtl/embedded/sysdir.inc30
-rw-r--r--rtl/emx/sysdir.inc66
-rw-r--r--rtl/gba/sysdir.inc6
-rw-r--r--rtl/go32v2/sysdir.inc45
-rw-r--r--rtl/inc/system.inc138
-rw-r--r--rtl/inc/systemh.inc17
-rw-r--r--rtl/macos/sysdir.inc16
-rw-r--r--rtl/morphos/sysdir.inc34
-rw-r--r--rtl/msdos/sysdir.inc43
-rw-r--r--rtl/nativent/sysdir.inc29
-rw-r--r--rtl/nds/sysdir.inc9
-rw-r--r--rtl/netware/sysdir.inc21
-rw-r--r--rtl/netwlibc/sysdir.inc11
-rw-r--r--rtl/objpas/objpas.pp33
-rw-r--r--rtl/os2/sysdir.inc33
-rw-r--r--rtl/symbian/sysdir.inc6
-rw-r--r--rtl/unix/sysdir.inc42
-rw-r--r--rtl/watcom/sysdir.inc26
-rw-r--r--rtl/wii/sysdir.inc20
-rw-r--r--rtl/win/sysdir.inc53
-rw-r--r--rtl/win/sysos.inc19
-rw-r--r--rtl/wince/system.pp29
-rw-r--r--tests/test/units/system/tdir2.pp135
24 files changed, 519 insertions, 384 deletions
diff --git a/rtl/amiga/sysdir.inc b/rtl/amiga/sysdir.inc
index 8f0c23b5d8..afe85788c1 100644
--- a/rtl/amiga/sysdir.inc
+++ b/rtl/amiga/sysdir.inc
@@ -3,7 +3,7 @@
Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
member of the Free Pascal development team.
- FPC Pascal system unit for the Win32 API.
+ FPC Pascal system unit for Amiga.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@@ -18,15 +18,14 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-procedure mkdir(s : pchar; len : sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s : rawbytestring);
var
- tmpStr : array[0..255] of char;
+ tmpStr : rawbytestring;
tmpLock: LongInt;
begin
checkCTRLC;
- if (s='') or (InOutRes<>0) then exit;
- tmpStr:=PathConv(s)+#0;
- tmpLock:=dosCreateDir(@tmpStr);
+ tmpStr:=PathConv(s);
+ tmpLock:=dosCreateDir(pchar(tmpStr));
if tmpLock=0 then begin
dosError2InOut(IoErr);
exit;
@@ -34,33 +33,35 @@ begin
UnLock(tmpLock);
end;
-procedure rmdir(s : pchar; len : sizeuint); [IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s : rawbytestring);
var
- tmpStr : array[0..255] of Char;
+ tmpStr : rawbytestring;
begin
checkCTRLC;
- if (s='.') then InOutRes:=16;
- If (s='') or (InOutRes<>0) then exit;
- tmpStr:=PathConv(s)+#0;
- if not dosDeleteFile(@tmpStr) then
+ if (s='.') then
+ begin
+ InOutRes:=16;
+ exit;
+ end;
+ tmpStr:=PathConv(s);
+ if not dosDeleteFile(pchar(tmpStr)) then
dosError2InOut(IoErr);
end;
-procedure sys_chdir(s : pchar);
+procedure do_ChDir(const s: rawbytestring);
var
- tmpStr : array[0..255] of Char;
+ tmpStr : rawbytestring;
tmpLock: LongInt;
FIB : PFileInfoBlock;
begin
checkCTRLC;
- If (s='') or (InOutRes<>0) then exit;
- tmpStr:=PathConv(s)+#0;
+ tmpStr:=PathConv(s);
tmpLock:=0;
{ Changing the directory is a pretty complicated affair }
{ 1) Obtain a lock on the directory }
{ 2) CurrentDir the lock }
- tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+ tmpLock:=Lock(pchar(tmpStr),SHARED_LOCK);
if tmpLock=0 then begin
dosError2InOut(IoErr);
exit;
@@ -81,13 +82,6 @@ begin
if assigned(FIB) then dispose(FIB);
end;
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- sys_chdir(s);
-end;
-
procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
var tmpbuf: array[0..255] of char;
begin
diff --git a/rtl/embedded/sysdir.inc b/rtl/embedded/sysdir.inc
index d09d914e2d..e4f62b37ea 100644
--- a/rtl/embedded/sysdir.inc
+++ b/rtl/embedded/sysdir.inc
@@ -19,29 +19,49 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-procedure mkdir(s: pchar;len:sizeuint);[IOCheck];
+{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+procedure do_mkdir(const s: rawbytestring);
begin
InOutRes:=3;
end;
-procedure rmdir(s: pchar;len:sizeuint);[IOCheck];
+procedure do_rmdir(const s: rawbytestring);
begin
InOutRes:=3;
end;
-procedure chdir(s: pchar;len:sizeuint);[IOCheck];
+procedure do_chdir(const s: rawbytestring);
begin
InOutRes:=3;
end;
-{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+ InOutRes:=3;
+end;
+
{$else FPC_HAS_FEATURE_ANSISTRINGS}
+
+procedure mkdir(const s: shortstring);
+begin
+ InOutRes:=3;
+end;
+
+procedure rmdir(const s: shortstring);
+begin
+ InOutRes:=3;
+end;
+
+procedure chdir(const s: shortstring);
+begin
+ InOutRes:=3;
+end;
+
procedure GetDir (DriveNr: byte; var Dir: ShortString);
-{$endif FPC_HAS_FEATURE_ANSISTRINGS}
begin
InOutRes:=3;
end;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
diff --git a/rtl/emx/sysdir.inc b/rtl/emx/sysdir.inc
index 5aeba91021..901bc85742 100644
--- a/rtl/emx/sysdir.inc
+++ b/rtl/emx/sysdir.inc
@@ -3,7 +3,7 @@
Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
member of the Free Pascal development team.
- FPC Pascal system unit for the Win32 API.
+ FPC Pascal system unit for EMX.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@@ -19,7 +19,7 @@
Directory Handling
*****************************************************************************}
-procedure DosDir (Func: byte; S: PChar);
+procedure DosDir (Func: byte; S: rawbytestring);
begin
DoDirSeparators (S);
@@ -33,17 +33,14 @@ begin
end ['eax', 'edx'];
end;
-procedure MkDir (S: pchar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_MKDIR'];
+procedure do_MkDir (S: rawbytestring);
var
RC: cardinal;
begin
- if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
- Exit;
-
if os_mode = osOs2 then
begin
DoDirSeparators (S);
- RC := DosCreateDir (S, nil);
+ RC := DosCreateDir (pchar(S), nil);
if RC <> 0 then
begin
InOutRes := RC;
@@ -60,49 +57,46 @@ begin
end;
-procedure RmDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_RMDIR'];
+procedure do_RmDir (S: rawbytestring);
var
RC: cardinal;
begin
- if Assigned (S) and (Len <> 0) and (InOutRes = 0) then
- begin
- if (Len = 1) and (S^ = '.') then
- InOutRes := 16
- else
- if os_mode = osOs2 then
+ if S = '.' then
+ InOutRes := 16
+ else
+ if os_mode = osOs2 then
+ begin
+ DoDirSeparators (S);
+ RC := DosDeleteDir (pchar(S));
+ if RC <> 0 then
begin
- DoDirSeparators (S);
- RC := DosDeleteDir (S);
- if RC <> 0 then
- begin
- InOutRes := RC;
- Errno2InOutRes;
- end;
- end
- else
- { Under EMX 0.9d DOS this routine call may sometimes fail }
- { The syscall documentation indicates clearly that this }
- { routine was NOT tested. }
- DosDir ($3A, S);
- end
+ InOutRes := RC;
+ Errno2InOutRes;
+ end;
+ end
+ else
+ { Under EMX 0.9d DOS this routine call may sometimes fail }
+ { The syscall documentation indicates clearly that this }
+ { routine was NOT tested. }
+ DosDir ($3A, S);
end;
{$ASMMODE INTEL}
-procedure ChDir (S: PChar; Len: SizeUInt); [IOCheck, public, alias: 'FPC_SYS_CHDIR'];
+procedure do_ChDir (S: rawbytestring);
var
RC: cardinal;
+ Len: longint;
begin
- if not Assigned (S) or (Len = 0) or (InOutRes <> 0) then
- exit;
(* According to EMX documentation, EMX has only one current directory
for all processes, so we'll use native calls under OS/2. *)
+ Len := Length (S);
if os_Mode = osOS2 then
begin
- if (Len >= 2) and (S [1] = ':') then
+ if (Len >= 2) and (S [2] = ':') then
begin
- RC := DosSetDefaultDisk ((Ord (S^) and not ($20)) - $40);
+ RC := DosSetDefaultDisk ((Ord (S[1]) and not ($20)) - $40);
if RC <> 0 then
begin
InOutRes := RC;
@@ -112,7 +106,7 @@ begin
if Len > 2 then
begin
DoDirSeparators (S);
- RC := DosSetCurrentDir (S);
+ RC := DosSetCurrentDir (pchar(S));
if RC <> 0 then
begin
InOutRes := RC;
@@ -123,7 +117,7 @@ begin
else
begin
DoDirSeparators (S);
- RC := DosSetCurrentDir (S);
+ RC := DosSetCurrentDir (pchar(S));
if RC <> 0 then
begin
InOutRes:= RC;
@@ -132,7 +126,7 @@ begin
end;
end
else
- if (Len >= 2) and (S [1] = ':') then
+ if (Len >= 2) and (S [2] = ':') then
begin
asm
mov esi, S
diff --git a/rtl/gba/sysdir.inc b/rtl/gba/sysdir.inc
index 39314f61d7..c454e5b1fc 100644
--- a/rtl/gba/sysdir.inc
+++ b/rtl/gba/sysdir.inc
@@ -19,17 +19,17 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
begin
end;
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
begin
end;
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
begin
end;
diff --git a/rtl/go32v2/sysdir.inc b/rtl/go32v2/sysdir.inc
index 134eaa5a68..6137de042d 100644
--- a/rtl/go32v2/sysdir.inc
+++ b/rtl/go32v2/sysdir.inc
@@ -3,7 +3,7 @@
Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
member of the Free Pascal development team.
- FPC Pascal system unit for the Win32 API.
+ FPC Pascal system unit for go32v2.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@@ -18,18 +18,20 @@
Directory Handling
*****************************************************************************}
-procedure DosDir(func:byte;s:pchar;len:integer);
+procedure DosDir(func:byte;s:rawbytestring);
var
regs : trealregs;
+ len : longint;
begin
DoDirSeparators(s);
{ True DOS does not like backslashes at end
Win95 DOS accepts this !!
but "\" and "c:\" should still be kept and accepted hopefully PM }
- if (len>0) and (s[len-1]='\') and
- Not ((len=1) or ((len=3) and (s[1]=':'))) then
- s[len-1]:=#0;
- syscopytodos(longint(s),len+1);
+ len:=length(s);
+ if (len>0) and (s[len]='\') and
+ Not ((len=1) or ((len=3) and (s[2]=':'))) then
+ s[len]:=#0;
+ syscopytodos(longint(pointer(s)),len+1);
regs.realedx:=tb_offset;
regs.realds:=tb_segment;
if LFNSupport then
@@ -41,32 +43,31 @@ begin
GetInOutRes(lo(regs.realeax));
end;
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- DosDir($39,s,len);
+ DosDir($39,s);
end;
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
begin
- if (len=1) and (s[0] = '.' ) then
- InOutRes := 16;
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- DosDir($3a,s,len);
+ if s='.' then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
+ DosDir($3a,s);
end;
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
var
regs : trealregs;
+ len : longint;
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
+ len:=length(s);
{ First handle Drive changes }
- if (len>=2) and (s[1]=':') then
+ if (len>=2) and (s[2]=':') then
begin
- regs.realedx:=(ord(s[0]) and (not 32))-ord('A');
+ regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
regs.realeax:=$0e00;
sysrealintr($21,regs);
regs.realeax:=$1900;
@@ -82,7 +83,7 @@ begin
exit;
end;
{ do the normal dos chdir }
- DosDir($3b,s,len);
+ DosDir($3b,s);
end;
procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
index 12ef258aa4..19b57a9966 100644
--- a/rtl/inc/system.inc
+++ b/rtl/inc/system.inc
@@ -1501,58 +1501,43 @@ end;
{$ifdef FPC_HAS_FEATURE_FILEIO}
{ OS dependent dir functions }
{$i sysdir.inc}
-{$endif FPC_HAS_FEATURE_FILEIO}
-
-{$if defined(FPC_HAS_FEATURE_FILEIO)}
-
+{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifndef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+procedure do_getdir(drivenr : byte;var dir : rawbytestring);
+var
+ u: unicodestring;
+begin
+ Do_getdir(drivenr,u);
+ widestringmanager.Unicode2AnsiMoveProc(pwidechar(u),dir,DefaultRTLFileSystemCodePage,length(u));
+end;
+{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
-Procedure MkDir(Const s: String);
-Var
- Buffer: Array[0..255] of Char;
+Procedure MkDir(Const s: RawByteString);[IOCheck];
Begin
If (s='') or (InOutRes <> 0) then
exit;
- Move(s[1], Buffer, Length(s));
- Buffer[Length(s)] := #0;
- MkDir(@buffer[0],length(s));
+ Do_mkdir(S);
End;
-Procedure RmDir(Const s: String);
-Var
- Buffer: Array[0..255] of Char;
+
+Procedure RmDir(Const s: RawByteString);[IOCheck];
Begin
If (s='') or (InOutRes <> 0) then
exit;
- Move(s[1], Buffer, Length(s));
- Buffer[Length(s)] := #0;
- RmDir(@buffer[0],length(s));
+ Do_rmdir(S);
End;
-Procedure ChDir(Const s: String);
-Var
- Buffer: Array[0..255] of Char;
+
+Procedure ChDir(Const s: RawByteString);[IOCheck];
Begin
If (s='') or (InOutRes <> 0) then
exit;
- Move(s[1], Buffer, Length(s));
- Buffer[Length(s)] := #0;
- ChDir(@buffer[0],length(s));
+ Do_chdir(S);
End;
-{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-
-{$ifndef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
-procedure do_getdir(drivenr : byte;var dir : rawbytestring);
-var
- u: unicodestring;
-begin
- Do_getdir(drivenr,u);
- widestringmanager.Unicode2AnsiMoveProc(pwidechar(u),dir,DefaultRTLFileSystemCodePage,length(u));
-end;
-{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
Procedure getdir(drivenr:byte;Var dir:rawbytestring);
begin
@@ -1562,9 +1547,47 @@ begin
setcodepage(dir,DefaultRTLFileSystemCodePage,true);
end;
-{ this one is only implemented elsewhere for systems *not* supporting
- ansi/unicodestrings; for now assume there are no systems that support
- unicodestrings but not ansistrings }
+{ the generic shortstring ones are only implemented elsewhere for systems *not*
+ supporting ansi/unicodestrings; for now assume there are no systems that
+ support unicodestrings but not ansistrings }
+
+{ avoid double string conversions }
+{$ifdef FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+function GetDirStrFromShortstring(const s: shortstring): RawByteString;
+begin
+ GetDirStrFromShortstring:=ToSingleByteFileSystemEncodedFileName(ansistring(s));
+end;
+{$else FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+function GetDirStrFromShortstring(const s: shortstring): UnicodeString;
+begin
+ GetDirStrFromShortstring:=s;
+end;
+{$endif FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+
+Procedure MkDir(Const s: shortstring);[IOCheck];
+Begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ Do_mkdir(GetDirStrFromShortstring(S));
+End;
+
+
+Procedure RmDir(Const s: shortstring);[IOCheck];
+Begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ Do_rmdir(GetDirStrFromShortstring(S));
+End;
+
+
+Procedure ChDir(Const s: shortstring);[IOCheck];
+Begin
+ If (s='') or (InOutRes <> 0) then
+ exit;
+ Do_chdir(GetDirStrFromShortstring(S));
+End;
+
+
Procedure getdir(drivenr:byte;Var dir:shortstring);
var
s: rawbytestring;
@@ -1581,6 +1604,26 @@ end;
{$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
{$ifndef FPCRTL_FILESYSTEM_TWO_BYTE_API}
+{ overloads required for mkdir/rmdir/chdir to ensure that the string is
+ converted to the right code page }
+procedure do_mkdir(const s: unicodestring); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ do_mkdir(ToSingleByteFileSystemEncodedFileName(s));
+end;
+
+
+procedure do_rmdir(const s: unicodestring); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ do_rmdir(ToSingleByteFileSystemEncodedFileName(s));
+end;
+
+
+procedure do_chdir(const s: unicodestring); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+ do_chdir(ToSingleByteFileSystemEncodedFileName(s));
+end;
+
+
procedure do_getdir(drivenr : byte;var dir : unicodestring);
var
s: rawbytestring;
@@ -1590,6 +1633,29 @@ begin
end;
{$endif FPCRTL_FILESYSTEM_TWO_BYTE_API}
+Procedure MkDir(Const s: UnicodeString);[IOCheck];
+Begin
+ if (s='') or (InOutRes <> 0) then
+ exit;
+ Do_mkdir(S);
+End;
+
+
+Procedure RmDir(Const s: UnicodeString);[IOCheck];
+Begin
+ if (s='') or (InOutRes <> 0) then
+ exit;
+ Do_rmdir(S);
+End;
+
+
+Procedure ChDir(Const s: UnicodeString);[IOCheck];
+Begin
+ if (s='') or (InOutRes <> 0) then
+ exit;
+ Do_chdir(S);
+End;
+
Procedure getdir(drivenr:byte;Var dir:unicodestring);
begin
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index 847d6d3666..f1b5674ddd 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -1178,24 +1178,29 @@ procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
Directory Management
****************************************************************************}
-
{$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure chdir(const s:string); overload;
-Procedure mkdir(const s:string); overload;
-Procedure rmdir(const s:string); overload;
-// the pchar versions are exported via alias for use in objpas
-
+Procedure chdir(const s:shortstring); overload;
+Procedure mkdir(const s:shortstring); overload;
+Procedure rmdir(const s:shortstring); overload;
Procedure getdir(drivenr:byte;var dir:shortstring);overload;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+Procedure chdir(const s:rawbytestring); overload;
+Procedure mkdir(const s:rawbytestring); overload;
+Procedure rmdir(const s:rawbytestring); overload;
// defaultrtlfilesystemcodepage is returned here
Procedure getdir(drivenr:byte;var dir: rawbytestring);overload;{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
+Procedure chdir(const s:unicodestring); overload;
+Procedure mkdir(const s:unicodestring); overload;
+Procedure rmdir(const s:unicodestring); overload;
Procedure getdir(drivenr:byte;var dir: unicodestring);overload;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$endif FPC_HAS_FEATURE_FILEIO}
+
+
{*****************************************************************************
Miscellaneous
*****************************************************************************}
diff --git a/rtl/macos/sysdir.inc b/rtl/macos/sysdir.inc
index 42c5226c9f..cd68dff8cc 100644
--- a/rtl/macos/sysdir.inc
+++ b/rtl/macos/sysdir.inc
@@ -18,16 +18,14 @@
Directory Handling
*****************************************************************************}
-procedure mkdir(const s:string);[IOCheck];
+procedure do_mkdir(const s: rawbytestring);
var
spec: FSSpec;
createdDirID: Longint;
err: OSErr;
res: Integer;
begin
- If (s='') or (InOutRes <> 0) then
- exit;
-
+ { TODO: convert PathArgToFSSpec (and the routines it calls) to rawbytestring }
res:= PathArgToFSSpec(s, spec);
if (res = 0) or (res = 2) then
begin
@@ -38,7 +36,7 @@ begin
InOutRes:=res;
end;
-procedure rmdir(const s:string);[IOCheck];
+procedure do_rmdir(const s: rawbytestring);
var
spec: FSSpec;
@@ -46,9 +44,6 @@ var
res: Integer;
begin
- If (s='') or (InOutRes <> 0) then
- exit;
-
res:= PathArgToFSSpec(s, spec);
if (res = 0) then
@@ -65,15 +60,12 @@ begin
InOutRes:=res;
end;
-procedure chdir(const s:string);[IOCheck];
+procedure do_chdir(const s: rawbytestring);
var
spec, newDirSpec: FSSpec;
err: OSErr;
res: Integer;
begin
- if (s='') or (InOutRes <> 0) then
- exit;
-
res:= PathArgToFSSpec(s, spec);
if (res = 0) or (res = 2) then
begin
diff --git a/rtl/morphos/sysdir.inc b/rtl/morphos/sysdir.inc
index 1d1555c197..11f9d2512d 100644
--- a/rtl/morphos/sysdir.inc
+++ b/rtl/morphos/sysdir.inc
@@ -17,15 +17,14 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
var
- tmpStr : array[0..255] of char;
+ tmpStr : rawbytestring;
tmpLock: LongInt;
begin
checkCTRLC;
- if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
- tmpStr:=PathConv(strpas(s))+#0;
- tmpLock:=dosCreateDir(@tmpStr);
+ tmpStr:=PathConv(s);
+ tmpLock:=dosCreateDir(pchar(tmpStr));
if tmpLock=0 then begin
dosError2InOut(IoErr);
exit;
@@ -33,34 +32,35 @@ begin
UnLock(tmpLock);
end;
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
var
- tmpStr : array[0..255] of Char;
+ tmpStr : rawbytestring;
begin
checkCTRLC;
- if not assigned(s) or (len=0) then exit;
- if (s='.') then InOutRes:=16;
- If (s='') or (InOutRes<>0) then exit;
- tmpStr:=PathConv(strpas(s))+#0;
- if not dosDeleteFile(@tmpStr) then
+ if (s='.') then
+ begin
+ InOutRes:=16;
+ exit;
+ end;
+ tmpStr:=PathConv(s);
+ if not dosDeleteFile(pchar(tmpStr)) then
dosError2InOut(IoErr);
end;
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
var
- tmpStr : array[0..255] of Char;
+ tmpStr : rawbytestring;
tmpLock: LongInt;
FIB : PFileInfoBlock;
begin
checkCTRLC;
- if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
- tmpStr:=PathConv(strpas(s))+#0;
+ tmpStr:=PathConv(s);
tmpLock:=0;
{ Changing the directory is a pretty complicated affair }
{ 1) Obtain a lock on the directory }
{ 2) CurrentDir the lock }
- tmpLock:=Lock(@tmpStr,SHARED_LOCK);
+ tmpLock:=Lock(pchar(tmpStr),SHARED_LOCK);
if tmpLock=0 then begin
dosError2InOut(IoErr);
exit;
diff --git a/rtl/msdos/sysdir.inc b/rtl/msdos/sysdir.inc
index 9ac513a535..eb8c941840 100644
--- a/rtl/msdos/sysdir.inc
+++ b/rtl/msdos/sysdir.inc
@@ -18,19 +18,21 @@
Directory Handling
*****************************************************************************}
-procedure DosDir(func:byte;s:pchar;len:integer);
+procedure DosDir(func:byte;s: rawbytestring);
var
regs : Registers;
+ len : Longint;
begin
DoDirSeparators(s);
{ True DOS does not like backslashes at end
Win95 DOS accepts this !!
but "\" and "c:\" should still be kept and accepted hopefully PM }
- if (len>0) and (s[len-1]='\') and
- Not ((len=1) or ((len=3) and (s[1]=':'))) then
- s[len-1]:=#0;
- regs.DX:=Ofs(s^);
- regs.DS:=Seg(s^);
+ len:=length(s);
+ if (len>0) and (s[len]='\') and
+ Not ((len=1) or ((len=3) and (s[2]=':'))) then
+ s[len]:=#0;
+ regs.DX:=Ofs(s[1]);
+ regs.DS:=Seg(s[1]);
if LFNSupport then
regs.AX:=$7100+func
else
@@ -40,32 +42,31 @@ begin
GetInOutRes(regs.AX);
end;
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- DosDir($39,s,len);
+ DosDir($39,s);
end;
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(const s: rawbytestring);
begin
- if (len=1) and (s[0] = '.' ) then
- InOutRes := 16;
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- DosDir($3a,s,len);
+ if s='.' then
+ begin
+ InOutRes:=16;
+ exit;
+ end;
+ DosDir($3a,s);
end;
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(const s: rawbytestring);
var
regs : Registers;
+ len : Longint;
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
+ len:=Length(s);
{ First handle Drive changes }
- if (len>=2) and (s[1]=':') then
+ if (len>=2) and (s[2]=':') then
begin
- regs.DX:=(ord(s[0]) and (not 32))-ord('A');
+ regs.DX:=(ord(s[1]) and (not 32))-ord('A');
regs.AX:=$0e00;
MsDos(regs);
regs.AX:=$1900;
diff --git a/rtl/nativent/sysdir.inc b/rtl/nativent/sysdir.inc
index 0a3407ffe7..9fa78f2f55 100644
--- a/rtl/nativent/sysdir.inc
+++ b/rtl/nativent/sysdir.inc
@@ -17,7 +17,7 @@
Directory Handling
*****************************************************************************}
-procedure MkDir(s: pchar; len: sizeuint); [IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_MkDir(const s: UnicodeString);
var
objattr: TObjectAttributes;
name: TNtUnicodeString;
@@ -25,10 +25,7 @@ var
iostatus: TIOStatusBlock;
h: THandle;
begin
- if not Assigned(s) or (len <= 1) or (InOutRes <> 0) then
- Exit;
-
- SysPCharToNtStr(name, s, len);
+ SysUnicodeStringToNtStr(name, s);
{ first we try to create a directory object }
SysInitializeObjectAttributes(objattr, @name, OBJ_PERMANENT, 0, Nil);
@@ -61,7 +58,7 @@ begin
SysFreeNtStr(name);
end;
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(const s: UnicodeString);
var
ntstr: TNtUnicodeString;
objattr: TObjectAttributes;
@@ -70,14 +67,18 @@ var
disp: TFileDispositionInformation;
res: LongInt;
begin
- if (len = 1) and (s^ = '.') then
- InOutRes := 16;
- if not assigned(s) or (len = 0) or (InOutRes <> 0) then
- Exit;
- if (len = 2) and (s[0] = '.') and (s[1] = '.') then
- InOutRes := 5;
+ if s = '.' then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
+ if s = '..' then
+ begin
+ InOutRes := 5;
+ exit;
+ end;
- SysPCharToNtStr(ntstr, s, len);
+ SysUnicodeStringToNtStr(ntstr, s);
SysInitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
res := NtOpenDirectoryObject(@h, STANDARD_RIGHTS_REQUIRED, @objattr);
@@ -115,7 +116,7 @@ begin
Errno2InoutRes;
end;
-procedure ChDir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(const s: UnicodeString);
begin
{ for now this is not supported }
InOutRes := 3;
diff --git a/rtl/nds/sysdir.inc b/rtl/nds/sysdir.inc
index 95a1ac5fbd..95ef09904a 100644
--- a/rtl/nds/sysdir.inc
+++ b/rtl/nds/sysdir.inc
@@ -19,21 +19,18 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
begin
- if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
end;
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
begin
- if not assigned(s) or (len=0) then exit;
end;
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
begin
- if not assigned(s) or (len=0) then exit;
end;
diff --git a/rtl/netware/sysdir.inc b/rtl/netware/sysdir.inc
index bc51efc770..204e316922 100644
--- a/rtl/netware/sysdir.inc
+++ b/rtl/netware/sysdir.inc
@@ -17,12 +17,10 @@
Directory Handling
*****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(s: rawbytestring);
var
Rc : longint;
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
DoDirSeparators(s);
Rc := _mkdir(pchar(s));
if Rc <> 0 then
@@ -30,13 +28,14 @@ begin
end;
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(s: rawbytestring);
var Rc : longint;
begin
- if (len=1) and (s^ = '.' ) then
- InOutRes := 16;
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
+ if s = '.' then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
DoDirSeparators(s);
Rc := _rmdir(pchar(s));
if Rc <> 0 then
@@ -44,16 +43,16 @@ begin
end;
-procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(s: rawbytestring);
var RC: longint;
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
+ DoDirSeparators(s);
RC := _chdir (pchar(s));
if Rc <> 0 then
SetFileError(Rc);
end;
+
procedure do_getdir(drivenr : byte;var dir : rawbytestring);
VAR P : ARRAY [0..255] OF CHAR;
i : LONGINT;
diff --git a/rtl/netwlibc/sysdir.inc b/rtl/netwlibc/sysdir.inc
index 20091a18c6..4fcdd11109 100644
--- a/rtl/netwlibc/sysdir.inc
+++ b/rtl/netwlibc/sysdir.inc
@@ -17,20 +17,20 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(const s: rawbytestring);
var Res: LONGINT;
BEGIN
- Res := FpMkdir (s,S_IRWXU);
+ Res := FpMkdir (pchar(s),S_IRWXU);
if Res = 0 then
InOutRes:=0
else
SetFileError (Res);
end;
-procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_RmDir(const s: rawbytestring);
var Res: longint;
begin
- Res := FpRmdir (s);
+ Res := FpRmdir (pchar(s));
if Res = 0 then
InOutRes:=0
else
@@ -38,7 +38,7 @@ begin
end;
-procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_ChDir(const s: rawbytestring);
var Res: longint;
begin
Res := FpChdir (s);
@@ -48,6 +48,7 @@ begin
SetFileError (Res);
end;
+
procedure do_getdir(drivenr : byte;var dir : rawbytestring);
var P : array [0..255] of CHAR;
i : LONGINT;
diff --git a/rtl/objpas/objpas.pp b/rtl/objpas/objpas.pp
index c0e343161e..a026e58786 100644
--- a/rtl/objpas/objpas.pp
+++ b/rtl/objpas/objpas.pp
@@ -87,12 +87,6 @@ Var
Function ParamStr(Param : Integer) : Ansistring;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
-{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
- Procedure MkDir(s:ansistring);overload;
- Procedure RmDir(s:ansistring);overload;
- Procedure ChDir(s:ansistring);overload;
-{$endif defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-
{****************************************************************************
Resource strings.
****************************************************************************}
@@ -130,9 +124,6 @@ Var
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure MkDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_MKDIR';
-Procedure ChDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_CHDIR';
-Procedure RmDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_RMDIR';
{ Untyped file support }
@@ -233,30 +224,6 @@ Function ParamStr(Param : Integer) : ansistring;
end;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
-
-{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-{ xxDirPChar procedures can adjust directory separators in supplied string (at least
- Windows implementation does so). Therefore full copy of argument is needed,
- just passing by value isn't enough because it won't copy a string literal. }
-Procedure MkDir(s:ansistring);[IOCheck];
-begin
- UniqueString(s);
- mkdirpchar(pchar(s),length(s));
-end;
-
-Procedure RmDir(s:ansistring);[IOCheck];
-begin
- UniqueString(s);
- RmDirpchar(pchar(s),length(s));
-end;
-
-Procedure ChDir(s:ansistring);[IOCheck];
-begin
- UniqueString(s);
- ChDirpchar(pchar(s),length(s));
-end;
-{$endif defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-
{$ifdef FPC_HAS_FEATURE_RESOURCES}
{ ---------------------------------------------------------------------
ResourceString support
diff --git a/rtl/os2/sysdir.inc b/rtl/os2/sysdir.inc
index ea44f50dca..9a0c6bf27b 100644
--- a/rtl/os2/sysdir.inc
+++ b/rtl/os2/sysdir.inc
@@ -19,14 +19,12 @@
Directory Handling
*****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_MkDir(s: rawbytestring);
var
Rc : word;
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
DoDirSeparators(s);
- Rc := DosCreateDir(s,nil);
+ Rc := DosCreateDir(pchar(s),nil);
if Rc <> 0 then
begin
InOutRes := Rc;
@@ -34,16 +32,17 @@ begin
end;
end;
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+Procedure do_RmDir(s: rawbytestring);
var
Rc : word;
begin
- if (len=1) and (s^ = '.' ) then
- InOutRes := 16;
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
+ if s = '.' then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
DoDirSeparators(s);
- Rc := DosDeleteDir(s);
+ Rc := DosDeleteDir(pchar(s));
if Rc <> 0 then
begin
InOutRes := Rc;
@@ -53,23 +52,23 @@ end;
{$ASMMODE INTEL}
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+Procedure do_ChDir(s: rawbytestring);
var RC: cardinal;
+ Len: Longint;
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- if (Len >= 2) and (S[1] = ':') then
+ Len := Length (s);
+ if (Len >= 2) and (S[2] = ':') then
begin
- RC := DosSetDefaultDisk ((Ord (S [0]) and not ($20)) - $40);
+ RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
if RC <> 0 then
InOutRes := RC
else
if Len > 2 then
begin
DoDirSeparators (s);
- RC := DosSetCurrentDir (s);
+ RC := DosSetCurrentDir (pchar (s));
if RC <> 0 then
begin
InOutRes := RC;
@@ -78,7 +77,7 @@ begin
end;
end else begin
DoDirSeparators (s);
- RC := DosSetCurrentDir (s);
+ RC := DosSetCurrentDir (pchar (s));
if RC <> 0 then
begin
InOutRes:= RC;
diff --git a/rtl/symbian/sysdir.inc b/rtl/symbian/sysdir.inc
index be95ab2d7d..dbdbebb5ed 100644
--- a/rtl/symbian/sysdir.inc
+++ b/rtl/symbian/sysdir.inc
@@ -17,17 +17,17 @@
Directory Handling
*****************************************************************************}
-procedure mkdir(const s:string);[IOCHECK];
+procedure do_mkdir(const s:rawbytestring);
begin
end;
-procedure rmdir(const s:string);[IOCHECK];
+procedure do_rmdir(const s:rawbytestring);
begin
end;
-procedure chdir(const s:string);[IOCHECK];
+procedure do_chdir(const s:rawbytestring);
begin
end;
diff --git a/rtl/unix/sysdir.inc b/rtl/unix/sysdir.inc
index c70d198d8c..1b2316b36a 100644
--- a/rtl/unix/sysdir.inc
+++ b/rtl/unix/sysdir.inc
@@ -18,7 +18,6 @@
Directory Handling
*****************************************************************************}
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
const
{ read/write search permission for everyone }
MODE_MKDIR = S_IWUSR OR S_IRUSR OR
@@ -26,39 +25,32 @@ const
S_IWOTH OR S_IROTH OR
S_IXUSR OR S_IXGRP OR S_IXOTH;
-// len is not passed to the *nix functions because the unix API doesn't
-// use length safeguards for these functions. (probably because there
-// already is a length limit due to PATH_MAX)
+Procedure Do_MkDir(s: rawbytestring);
Begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- If Fpmkdir(s, MODE_MKDIR)<0 Then
+ If Fpmkdir(pchar(s), MODE_MKDIR)<0 Then
Errno2Inoutres
- Else
- InOutRes:=0;
End;
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-Begin
- if (len=1) and (s^ = '.') then
- InOutRes := 16;
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- If Fprmdir(s)<0 Then
+
+Procedure Do_RmDir(s: rawbytestring);
+
+begin
+ if (s='.') then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
+ If Fprmdir(pchar(S))<0 Then
Errno2Inoutres
- Else
- InOutRes:=0;
End;
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+
+Procedure do_ChDir(s: rawbytestring);
+
Begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- If Fpchdir(s)<0 Then
- Errno2Inoutres
- Else
- InOutRes:=0;
+ If Fpchdir(pchar(s))<0 Then
+ Errno2Inoutres;
{ file not exists is path not found under tp7 }
if InOutRes=2 then
InOutRes:=3;
diff --git a/rtl/watcom/sysdir.inc b/rtl/watcom/sysdir.inc
index eaba0a6f1f..f5ff8e862f 100644
--- a/rtl/watcom/sysdir.inc
+++ b/rtl/watcom/sysdir.inc
@@ -2,11 +2,16 @@
Directory Handling
*****************************************************************************}
-procedure DosDir(func:byte;const s:string);
+procedure DosDir(func:byte;const s:rawbytestring);
var
buffer : array[0..255] of char;
regs : trealregs;
begin
+ if length(s)>255 then
+ begin
+ inoutres:=3;
+ exit;
+ end;
move(s[1],buffer,length(s));
buffer[length(s)]:=#0;
DoDirSeparators(pchar(@buffer));
@@ -29,30 +34,27 @@ begin
end;
-procedure mkdir(const s : string);[IOCheck];
+procedure do_mkdir(const s : rawbytestring);
begin
- If (s='') or (InOutRes <> 0) then
- exit;
DosDir($39,s);
end;
-procedure rmdir(const s : string);[IOCheck];
+procedure do_rmdir(const s : rawbytestring);
begin
- if (s = '.' ) then
- InOutRes := 16;
- If (s='') or (InOutRes <> 0) then
- exit;
+ if s = '.' then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
DosDir($3a,s);
end;
-procedure chdir(const s : string);[IOCheck];
+procedure do_chdir(const s : rawbytestring);
var
regs : trealregs;
begin
- If (s='') or (InOutRes <> 0) then
- exit;
{ First handle Drive changes }
if (length(s)>=2) and (s[2]=':') then
begin
diff --git a/rtl/wii/sysdir.inc b/rtl/wii/sysdir.inc
index fe3ac27b0d..a96a8ac6cc 100644
--- a/rtl/wii/sysdir.inc
+++ b/rtl/wii/sysdir.inc
@@ -18,28 +18,28 @@
{*****************************************************************************
Directory Handling
*****************************************************************************}
-procedure mkdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+procedure do_mkdir(const s: rawbytestring);
begin
- if not assigned(s) or (len=0) or (InOutRes<>0) then exit;
+ { TODO: convert callback to use rawbytestring to avoid conversion }
if FileIODevice.DirIO.DoMkdir <> nil then
- FileIODevice.DirIO.DoMkdir(strpas(s));
+ FileIODevice.DirIO.DoMkdir(s);
end;
-procedure rmdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+procedure do_rmdir(const s: rawbytestring);
begin
- if not assigned(s) or (len=0) then exit;
+ { TODO: convert callback to use rawbytestring to avoid conversion }
if FileIODevice.DirIO.DoRmdir <> nil then
- FileIODevice.DirIO.DoRmdir(strpas(s));
+ FileIODevice.DirIO.DoRmdir(s);
end;
-procedure chdir(s: pchar; len: sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+procedure do_chdir(const s: rawbytestring);
begin
- if not assigned(s) or (len=0) then exit;
+ { TODO: convert callback to use rawbytestring to avoid conversion }
if FileIODevice.DirIO.DoChdir <> nil then
- FileIODevice.DirIO.DoChdir(strpas(s));
+ FileIODevice.DirIO.DoChdir(pchar(s));
end;
-procedure GetDir(DriveNr: byte; var Dir: RawByteString);
+procedure do_GetDir(DriveNr: byte; var Dir: RawByteString);
var
TmpDir: ShortString;
begin
diff --git a/rtl/win/sysdir.inc b/rtl/win/sysdir.inc
index d0aafc11cd..34ea24c42a 100644
--- a/rtl/win/sysdir.inc
+++ b/rtl/win/sysdir.inc
@@ -20,53 +20,50 @@
type
TDirFnType=function(name:pointer):longbool;stdcall;
-procedure dirfn(afunc : TDirFnType;s:pchar;len:integer);
+function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+begin
+ CreateDirectoryTrunc:=CreateDirectoryW(name,nil);
+end;
+
+procedure dirfn(afunc : TDirFnType;s:unicodestring);
begin
DoDirSeparators(s);
- if not aFunc(s) then
+ if not aFunc(punicodechar(s)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end;
-
-function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+Procedure do_MkDir(const s: UnicodeString);
begin
- CreateDirectoryTrunc:=CreateDirectory(name,nil);
+ dirfn(TDirFnType(@CreateDirectoryTrunc),s);
end;
-Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
+Procedure do_RmDir(const s: UnicodeString);
begin
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- dirfn(TDirFnType(@CreateDirectoryTrunc),s,len);
-end;
-
-Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-
-begin
- if (len=1) and (s^ ='.') then
- InOutRes := 16;
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
-{$ifdef WINCE}
- if (len=2) and (s[0]='.') and (s[1]='.') then
- InOutRes := 5;
-{$endif WINCE}
- dirfn(TDirFnType(@RemoveDirectory),s,len);
+ if (s ='.') then
+ begin
+ InOutRes := 16;
+ exit;
+ end;
+ {$ifdef WINCE}
+ if (s='..') then
+ begin
+ InOutRes := 5;
+ exit;
+ end;
+ {$endif WINCE}
+ dirfn(TDirFnType(@RemoveDirectoryW),s);
{$ifdef WINCE}
if (Inoutres=3) and (Pos(DirectorySeparator, s)<2) then
Inoutres:=2;
{$endif WINCE}
end;
-Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-
+Procedure do_ChDir(const s: UnicodeString);
begin
{$ifndef WINCE}
- If not assigned(s) or (len=0) or (InOutRes <> 0) then
- exit;
- dirfn(TDirFnType(@SetCurrentDirectory),s,len);
+ dirfn(TDirFnType(@SetCurrentDirectoryW),s);
if Inoutres=2 then
Inoutres:=3;
{$else WINCE}
diff --git a/rtl/win/sysos.inc b/rtl/win/sysos.inc
index 7fad23a1ce..53d1d8d826 100644
--- a/rtl/win/sysos.inc
+++ b/rtl/win/sysos.inc
@@ -291,13 +291,6 @@ threadvar
lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
stdcall;external KernelDLL name 'CreateFileW';
- { Directory }
- function CreateDirectory(name : pointer;sec : pointer) : longbool;
- stdcall;external KernelDLL name 'CreateDirectoryW';
- function RemoveDirectory(name:pointer):longbool;
- stdcall;external KernelDLL name 'RemoveDirectoryW';
- function SetCurrentDirectory(name : pointer) : longbool;
- stdcall;external KernelDLL name 'SetCurrentDirectoryW';
{$else}
function GetFileAttributes(p : pchar) : dword;
stdcall;external KernelDLL name 'GetFileAttributesA';
@@ -309,16 +302,12 @@ threadvar
lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):THandle;
stdcall;external KernelDLL name 'CreateFileA';
- { Directory }
- function CreateDirectory(name : pointer;sec : pointer) : longbool;
- stdcall;external KernelDLL name 'CreateDirectoryA';
- function RemoveDirectory(name:pointer):longbool;
- stdcall;external KernelDLL name 'RemoveDirectoryA';
- function SetCurrentDirectory(name : pointer) : longbool;
- stdcall;external KernelDLL name 'SetCurrentDirectoryA';
-
{$endif}
{ Directory }
+ function CreateDirectoryW(name : pointer;sec : pointer) : longbool;
+ stdcall;external KernelDLL name 'CreateDirectoryW';
+ function RemoveDirectoryW(name:pointer):longbool;
+ stdcall;external KernelDLL name 'RemoveDirectoryW';
function SetCurrentDirectoryW(name : pointer) : longbool;
stdcall;external KernelDLL name 'SetCurrentDirectoryW';
function GetCurrentDirectoryW(bufsize : longint;name : punicodechar) : Dword;
diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp
index 2e9cf52625..ff93dae8b3 100644
--- a/rtl/wince/system.pp
+++ b/rtl/wince/system.pp
@@ -94,9 +94,6 @@ function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD;
lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
-function CreateDirectory(name : pointer;sec : pointer) : longbool;
-function RemoveDirectory(name:pointer):longbool;
-
{$ifdef CPUARM}
{ the external directive isn't really necessary here because it is overridden by external (FK) }
@@ -206,6 +203,12 @@ var
function MessageBox(w1:longint;l1,l2:PWideChar;w2:longint):longint;
cdecl; external 'coredll' name 'MessageBoxW';
+function CreateDirectoryW(name : pwidechar;sec : pointer) : longbool;
+ cdecl; external KernelDLL name 'CreateDirectoryW';
+function RemoveDirectoryW(name:pwidechar):longbool;
+ cdecl; external KernelDLL name 'RemoveDirectoryW';
+
+
{*****************************************************************************}
{$define FPC_SYSTEM_HAS_MOVE}
@@ -424,10 +427,6 @@ function CreateFileW(lpFileName:pwidechar; dwDesiredAccess:DWORD; dwShareMode:DW
lpSecurityAttributes:pointer; dwCreationDisposition:DWORD;
dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
cdecl; external KernelDLL name 'CreateFileW';
-function CreateDirectoryW(name : pwidechar;sec : pointer) : longbool;
- cdecl; external KernelDLL name 'CreateDirectoryW';
-function RemoveDirectoryW(name:pwidechar):longbool;
- cdecl; external KernelDLL name 'RemoveDirectoryW';
function GetFileAttributes(p : pchar) : dword;
var
@@ -465,22 +464,6 @@ begin
dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile);
end;
-function CreateDirectory(name : pointer;sec : pointer) : longbool;
-var
- buf: array[0..MaxPathLen] of WideChar;
-begin
- AnsiToWideBuf(name, -1, buf, SizeOf(buf));
- CreateDirectory := CreateDirectoryW(buf, sec);
-end;
-
-function RemoveDirectory(name:pointer):longbool;
-var
- buf: array[0..MaxPathLen] of WideChar;
-begin
- AnsiToWideBuf(name, -1, buf, SizeOf(buf));
- RemoveDirectory := RemoveDirectoryW(buf);
-end;
-
const
{$ifdef CPUARM}
UserKData = $FFFFC800;
diff --git a/tests/test/units/system/tdir2.pp b/tests/test/units/system/tdir2.pp
new file mode 100644
index 0000000000..8dac0d535e
--- /dev/null
+++ b/tests/test/units/system/tdir2.pp
@@ -0,0 +1,135 @@
+{ Program to test OS-specific features of the system unit }
+{ routines to test: }
+{ mkdir() }
+{ chdir() }
+{ rmdir() }
+{ getdir() }
+{ This program tests support for non-ASCII chaaracters in }
+{ path names }
+
+{ %target=win32,win64,darwin,freebsd,openbsd,netbsd,linux,morphos,haiku,aix,nativent }
+
+Program tdir;
+{$codepage utf-8}
+{$I-}
+
+{$ifdef unix}
+uses
+ cwstring;
+{$endif}
+
+procedure test(value, required: longint);
+begin
+ if value <> required then
+ begin
+ writeln('Got ',value,' instead of ',required);
+ halt(1);
+ end;
+end;
+
+
+procedure testansi;
+const
+ dirname: utf8string = '鿆®';
+var
+ orgdir, newdir: rawbytestring;
+Begin
+ Writeln('rawbytestring tests');
+ Write('Getting current directory...');
+ getdir(0,orgdir);
+ test(IOResult,0);
+ WriteLn('Passed');
+
+ Write('creating new directory...');
+ mkdir(dirname);
+ test(IOResult,0);
+ WriteLn('Passed');
+
+ Write('changing to new directory...');
+ chdir(dirname);
+ test(IOResult, 0);
+ WriteLn('Passed!');
+
+ Write('Getting current directory again...');
+ getdir(0,newdir);
+ test(IOResult,0);
+ WriteLn('Passed');
+
+ Write('Checking whether the current directories are properly relative to each other...');
+ if newdir[length(newdir)]=DirectorySeparator then
+ setlength(newdir,length(newdir)-1);
+ setcodepage(newdir,CP_UTF8);
+ if copy(newdir,1,length(orgdir))<>orgdir then
+ test(0,1);
+ if copy(newdir,length(newdir)-length(dirname)+1,length(dirname))<>dirname then
+ test(2,3);
+ Writeln('Passed');
+
+ Write('going directory up ...');
+ chdir('..');
+ test(IOResult, 0);
+ WriteLn('Passed!');
+
+ Write('removing directory ...');
+ rmdir(dirname);
+ test(IOResult, 0);
+ WriteLn('Passed!');
+end;
+
+
+procedure testuni;
+const
+ dirname: unicodestring = '鿆®';
+var
+ orgdir, newdir: unicodestring;
+Begin
+ Writeln('unicodestring tests');
+ Write('Getting current directory...');
+ getdir(0,orgdir);
+ test(IOResult,0);
+ WriteLn('Passed');
+
+ Write('creating new directory...');
+ mkdir(dirname);
+ test(IOResult,0);
+ WriteLn('Passed');
+
+ Write('changing to new directory...');
+ chdir(dirname);
+ test(IOResult, 0);
+ WriteLn('Passed!');
+
+ Write('Getting current directory again...');
+ getdir(0,newdir);
+ test(IOResult,0);
+ WriteLn('Passed');
+
+ Write('Checking whether the current directories are properly relative to each other...');
+ if newdir[length(newdir)]=DirectorySeparator then
+ setlength(newdir,length(newdir)-1);
+ if copy(newdir,1,length(orgdir))<>orgdir then
+ test(0,1);
+ if copy(newdir,length(newdir)-length(dirname)+1,length(dirname))<>dirname then
+ test(2,3);
+ Writeln('Passed');
+
+ Write('going directory up ...');
+ chdir('..');
+ test(IOResult, 0);
+ WriteLn('Passed!');
+
+ Write('removing directory ...');
+ rmdir(dirname);
+ test(IOResult, 0);
+ WriteLn('Passed!');
+end;
+
+begin
+ { ensure that we get into trouble if at one point defaultsystemcodepage is used }
+ SetMultiByteConversionCodePage(CP_ASCII);
+ { this test only works in its current form on systems that either use a two byte file system OS API, or whose 1-byte API supports UTF-8 }
+ SetMultiByteFileSystemCodePage(CP_UTF8);
+ SetMultiByteRTLFileSystemCodePage(CP_UTF8);
+ testansi;
+ testuni;
+end.