|
@@ -1501,58 +1501,43 @@ end;
|
|
{$ifdef FPC_HAS_FEATURE_FILEIO}
|
|
{$ifdef FPC_HAS_FEATURE_FILEIO}
|
|
{ OS dependent dir functions }
|
|
{ OS dependent dir functions }
|
|
{$i sysdir.inc}
|
|
{$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
|
|
Begin
|
|
If (s='') or (InOutRes <> 0) then
|
|
If (s='') or (InOutRes <> 0) then
|
|
exit;
|
|
exit;
|
|
- Move(s[1], Buffer, Length(s));
|
|
|
|
- Buffer[Length(s)] := #0;
|
|
|
|
- MkDir(@buffer[0],length(s));
|
|
|
|
|
|
+ Do_mkdir(S);
|
|
End;
|
|
End;
|
|
|
|
|
|
-Procedure RmDir(Const s: String);
|
|
|
|
-Var
|
|
|
|
- Buffer: Array[0..255] of Char;
|
|
|
|
|
|
+
|
|
|
|
+Procedure RmDir(Const s: RawByteString);[IOCheck];
|
|
Begin
|
|
Begin
|
|
If (s='') or (InOutRes <> 0) then
|
|
If (s='') or (InOutRes <> 0) then
|
|
exit;
|
|
exit;
|
|
- Move(s[1], Buffer, Length(s));
|
|
|
|
- Buffer[Length(s)] := #0;
|
|
|
|
- RmDir(@buffer[0],length(s));
|
|
|
|
|
|
+ Do_rmdir(S);
|
|
End;
|
|
End;
|
|
|
|
|
|
-Procedure ChDir(Const s: String);
|
|
|
|
-Var
|
|
|
|
- Buffer: Array[0..255] of Char;
|
|
|
|
|
|
+
|
|
|
|
+Procedure ChDir(Const s: RawByteString);[IOCheck];
|
|
Begin
|
|
Begin
|
|
If (s='') or (InOutRes <> 0) then
|
|
If (s='') or (InOutRes <> 0) then
|
|
exit;
|
|
exit;
|
|
- Move(s[1], Buffer, Length(s));
|
|
|
|
- Buffer[Length(s)] := #0;
|
|
|
|
- ChDir(@buffer[0],length(s));
|
|
|
|
|
|
+ Do_chdir(S);
|
|
End;
|
|
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);
|
|
Procedure getdir(drivenr:byte;Var dir:rawbytestring);
|
|
begin
|
|
begin
|
|
@@ -1562,9 +1547,47 @@ begin
|
|
setcodepage(dir,DefaultRTLFileSystemCodePage,true);
|
|
setcodepage(dir,DefaultRTLFileSystemCodePage,true);
|
|
end;
|
|
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);
|
|
Procedure getdir(drivenr:byte;Var dir:shortstring);
|
|
var
|
|
var
|
|
s: rawbytestring;
|
|
s: rawbytestring;
|
|
@@ -1581,6 +1604,26 @@ end;
|
|
{$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
|
|
{$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
|
|
|
|
|
|
{$ifndef FPCRTL_FILESYSTEM_TWO_BYTE_API}
|
|
{$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);
|
|
procedure do_getdir(drivenr : byte;var dir : unicodestring);
|
|
var
|
|
var
|
|
s: rawbytestring;
|
|
s: rawbytestring;
|
|
@@ -1590,6 +1633,29 @@ begin
|
|
end;
|
|
end;
|
|
{$endif FPCRTL_FILESYSTEM_TWO_BYTE_API}
|
|
{$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);
|
|
Procedure getdir(drivenr:byte;Var dir:unicodestring);
|
|
begin
|
|
begin
|