* ansistring versions of mk/rm/chdir in objpas, Mantis 15010. The os-dependant routines of *nix/os2/win/dos have been converted

git-svn-id: trunk@14211 -

rtl/go32v2/sysdir.inc

@@ -18,21 +18,18 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure DosDir(func:byte;const s:string);
+procedure DosDir(func:byte;s:pchar;len:integer);
 var
-  buffer : array[0..255] of char;
   regs   : trealregs;
 begin
-  move(s[1],buffer,length(s));
+  DoDirSeparators(s);
-  buffer[length(s)]:=#0;
-  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 }
-  if (length(s)>0) and (buffer[length(s)-1]='\') and
+  if (len>0) and (s[len-1]='\') and
-     Not ((length(s)=1) or ((length(s)=3) and (s[2]=':'))) then
+     Not ((len=1) or ((len=3) and (s[1]=':'))) then
-    buffer[length(s)-1]:=#0;
+    s[len-1]:=#0;
-  syscopytodos(longint(@buffer),length(s)+1);
+  syscopytodos(longint(s),len+1);
   regs.realedx:=tb_offset;
   regs.realds:=tb_segment;
   if LFNSupport then
@@ -44,35 +41,32 @@ begin
    GetInOutRes(lo(regs.realeax));
 end;
 
-
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
-procedure mkdir(const s : string);[IOCheck];
 begin
-  If (s='') or (InOutRes <> 0) then
+ If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  DosDir($39,s);
+  DosDir($39,s,len);
 end;
 
-
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-procedure rmdir(const s : string);[IOCheck];
 begin
-  if (s = '.' ) then
+  if (len=1) and (s[0] = '.' ) then
     InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  DosDir($3a,s);
+  DosDir($3a,s,len);
 end;
 
-
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-procedure chdir(const s : string);[IOCheck];
 var
   regs : trealregs;
 begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
 { First handle Drive changes }
-  if (length(s)>=2) and (s[2]=':') then
+  if (len>=2) and (s[1]=':') then
    begin
-     regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
+     regs.realedx:=(ord(s[0]) and (not 32))-ord('A');
      regs.realeax:=$0e00;
      sysrealintr($21,regs);
      regs.realeax:=$1900;
@@ -84,14 +78,13 @@ begin
       end;
      { DosDir($3b,'c:') give Path not found error on
        pure DOS PM }
-     if length(s)=2 then
+     if len=2 then
        exit;
    end;
 { do the normal dos chdir }
-  DosDir($3b,s);
+  DosDir($3b,s,len);
 end;
 
-
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
 var
   temp : array[0..255] of char;

rtl/inc/system.inc

@@ -588,21 +588,6 @@ Begin
 End;
 
 
-{*****************************************************************************
-                             Directory support.
-*****************************************************************************}
-
-{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
-Procedure getdir(drivenr:byte;Var dir:ansistring);
-{ this is needed to also allow ansistrings, the shortstring version is
-  OS dependent }
-var
-  s : shortstring;
-begin
-  getdir(drivenr,s);
-  dir:=s;
-end;
-{$endif}
 
 {$ifopt R+}
 {$define RangeCheckWasOn}
@@ -1340,6 +1325,54 @@ end;
 { OS dependent dir functions }
 {$i sysdir.inc}
 
+{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+Procedure getdir(drivenr:byte;Var dir:ansistring);
+{ this is needed to also allow ansistrings, the shortstring version is
+  OS dependent }
+var
+  s : shortstring;
+begin
+  getdir(drivenr,s);
+  dir:=s;
+end;
+{$endif}
+
+{$if defined(FPC_HAS_FEATURE_FILEIO)}
+
+Procedure MkDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  MkDir(@buffer[0],length(s));
+End;
+
+Procedure RmDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  RmDir(@buffer[0],length(s));
+End;
+
+Procedure ChDir(Const s: String);
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  ChDir(@buffer[0],length(s));
+End;
+{$endif}
+
 {*****************************************************************************
                             Resources support
 *****************************************************************************}

rtl/inc/systemh.inc

@@ -874,16 +874,17 @@ Procedure SetTextLineEnding(var f:Text; Ending:string);
 
 
 {$ifdef FPC_HAS_FEATURE_FILEIO}
-Procedure chdir(const s:string);
+Procedure chdir(const s:string); overload;
-Procedure mkdir(const s:string);
+Procedure mkdir(const s:string); overload;
-Procedure rmdir(const s:string);
+Procedure rmdir(const s:string); overload;
+// the pchar versions are exported via alias for use in objpas
+
 Procedure getdir(drivenr:byte;var dir:shortstring);
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure getdir(drivenr:byte;var dir:ansistring);
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$endif FPC_HAS_FEATURE_FILEIO}
 
-
 {*****************************************************************************
                              Miscellaneous
 *****************************************************************************}

rtl/objpas/objpas.pp

@@ -70,6 +70,10 @@ Var
      { ParamStr should return also an ansistring }
      Function ParamStr(Param : Integer) : Ansistring;
 
+     Procedure MkDir(const s:ansistring);overload;
+     Procedure RmDir(const s:ansistring);overload;
+     Procedure ChDir(const s:ansistring);overload;
+
 {****************************************************************************
                              Resource strings.
 ****************************************************************************}
@@ -104,6 +108,10 @@ Var
                              Compatibility routines.
 ****************************************************************************}
 
+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 }
 
 Procedure AssignFile(out f:File;const Name:string);
@@ -207,6 +215,20 @@ begin
 end;
 
 
+Procedure MkDir(const s:ansistring);
+begin
+  mkdirpchar(pchar(s),length(s));
+end;
+
+Procedure RmDir(const s:ansistring);
+begin
+  RmDirpchar(pchar(s),length(s));
+end;
+
+Procedure ChDir(const s:ansistring);
+begin
+  ChDirpchar(pchar(s),length(s));
+end;
 
 { ---------------------------------------------------------------------
     ResourceString support

rtl/os2/sysdir.inc

@@ -19,64 +19,57 @@
                            Directory Handling
 *****************************************************************************}
 
-procedure MkDir (const S: string);[IOCHECK];
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
-var buffer:array[0..255] of char;
+var 
     Rc : word;
 begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+    exit;
-      move(s[1],buffer,length(s));
+  DoDirSeparators(s);
-      buffer[length(s)]:=#0;
+  Rc := DosCreateDir(s,nil);
-      DoDirSeparators(Pchar(@buffer));
+  if Rc <> 0 then
-      Rc := DosCreateDir(buffer,nil);
+    begin
-      if Rc <> 0 then
+      InOutRes := Rc;
-       begin
+      Errno2Inoutres;
-         InOutRes := Rc;
+    end;
-         Errno2Inoutres;
-       end;
 end;
 
-
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-procedure rmdir(const s : string);[IOCHECK];
+var 
-var buffer:array[0..255] of char;
     Rc : word;
 begin
-  if (s = '.' ) then
+  if (len=1) and (s^ = '.' ) then
     InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+    exit;
-      move(s[1],buffer,length(s));
+  DoDirSeparators(s);
-      buffer[length(s)]:=#0;
+  Rc := DosDeleteDir(s);
-      DoDirSeparators(Pchar(@buffer));
+  if Rc <> 0 then
-      Rc := DosDeleteDir(buffer);
+    begin
-      if Rc <> 0 then
+      InOutRes := Rc;
-       begin
+      Errno2Inoutres;
-         InOutRes := Rc;
+    end;
-         Errno2Inoutres;
-       end;
 end;
 
 {$ASMMODE INTEL}
 
-procedure ChDir (const S: string);[IOCheck];
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
 
 var RC: cardinal;
-    Buffer: array [0..255] of char;
 
 begin
-  If (s='') or (InOutRes <> 0) then exit;
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-  if (Length (S) >= 2) and (S [2] = ':') then
+    exit;
+  if (Len >= 2) and (S[1] = ':') then
   begin
-    RC := DosSetDefaultDisk ((Ord (S [1]) and not ($20)) - $40);
+    RC := DosSetDefaultDisk ((Ord (S [0]) and not ($20)) - $40);
     if RC <> 0 then
       InOutRes := RC
     else
-      if Length (S) > 2 then
+      if Len > 2 then
       begin
-        Move (S [1], Buffer, Length (S));
+        DoDirSeparators (s);
-        Buffer [Length (S)] := #0;
+        RC := DosSetCurrentDir (s);
-        DoDirSeparators (PChar (@Buffer));
-        RC := DosSetCurrentDir (@Buffer);
         if RC <> 0 then
         begin
           InOutRes := RC;
@@ -84,10 +77,8 @@ begin
         end;
       end;
   end else begin
-    Move (S [1], Buffer, Length (S));
+    DoDirSeparators (s);
-    Buffer [Length (S)] := #0;
+    RC := DosSetCurrentDir (s);
-    DoDirSeparators (PChar (@Buffer));
-    RC := DosSetCurrentDir (@Buffer);
     if RC <> 0 then
     begin
       InOutRes:= RC;

rtl/unix/sysdir.inc

@@ -18,53 +18,44 @@
                            Directory Handling
 *****************************************************************************}
 
-Procedure MkDir(Const s: String);[IOCheck];
+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
                S_IWGRP OR S_IRGRP OR
                S_IWOTH OR S_IROTH OR
                S_IXUSR OR S_IXGRP OR S_IXOTH;
-Var
+
-  Buffer: Array[0..255] of Char;
+// 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)
+
 Begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+    exit;
-  Move(s[1], Buffer, Length(s));
+  If Fpmkdir(s, MODE_MKDIR)<0 Then
-  Buffer[Length(s)] := #0;
-  If Fpmkdir(@buffer[0], MODE_MKDIR)<0 Then
    Errno2Inoutres
   Else
    InOutRes:=0;
 End;
 
-
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
-Procedure RmDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
 Begin
-  if (s = '.') then
+  if (len=1) and (s^ = '.') then
     InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
-   exit;
+    exit;
-  Move(s[1], Buffer, Length(s));
+  If Fprmdir(s)<0 Then
-  Buffer[Length(s)] := #0;
-  If Fprmdir(@buffer[0])<0 Then
    Errno2Inoutres
   Else
    InOutRes:=0;
 End;
 
-
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
-Procedure ChDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
 Begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  Move(s[1], Buffer, Length(s));
+  If Fpchdir(s)<0 Then
-  Buffer[Length(s)] := #0;
-  If Fpchdir(@buffer[0])<0 Then
    Errno2Inoutres
   Else
    InOutRes:=0;

rtl/win/sysdir.inc

@@ -17,18 +17,13 @@
 {*****************************************************************************
                            Directory Handling
 *****************************************************************************}
-
 type
  TDirFnType=function(name:pointer):longbool;stdcall;
 
-procedure dirfn(afunc : TDirFnType;const s:string);
+procedure dirfn(afunc : TDirFnType;s:pchar;len:integer);
-var
-  buffer : array[0..255] of char;
 begin
-  move(s[1],buffer,length(s));
+  DoDirSeparators(s);
-  buffer[length(s)]:=#0;
+  if not aFunc(s) then
-  DoDirSeparators(pchar(@buffer));
-  if not aFunc(@buffer) then
     begin
       errno:=GetLastError;
       Errno2InoutRes;
@@ -40,36 +35,38 @@ begin
   CreateDirectoryTrunc:=CreateDirectory(name,nil);
 end;
 
-procedure mkdir(const s:string);[IOCHECK];
+Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR'];
 begin
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
+  dirfn(TDirFnType(@CreateDirectoryTrunc),s,len);
 end;
 
-procedure rmdir(const s:string);[IOCHECK];
+Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR'];
+
 begin
-  if (s ='.') then
+  if (len=1) and (s^ ='.') then
     InOutRes := 16;
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
+   exit;
 {$ifdef WINCE}
-  if (s ='..') then
+  if (len=2) and (s[0]='.') and (s[1]='.') then
     InOutRes := 5;
 {$endif WINCE}
-  If (s='') or (InOutRes <> 0) then
+  dirfn(TDirFnType(@RemoveDirectory),s,len);
-   exit;
-  dirfn(TDirFnType(@RemoveDirectory),s);
 {$ifdef WINCE}
   if (Inoutres=3) and (Pos(DirectorySeparator, s)<2) then
     Inoutres:=2;
 {$endif WINCE}
 end;
 
-procedure chdir(const s:string);[IOCHECK];
+Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR'];
+
 begin
 {$ifndef WINCE}
-  If (s='') or (InOutRes <> 0) then
+  If not assigned(s) or (len=0) or (InOutRes <> 0) then
    exit;
-  dirfn(TDirFnType(@SetCurrentDirectory),s);
+  dirfn(TDirFnType(@SetCurrentDirectory),s,len);
   if Inoutres=2 then
    Inoutres:=3;
 {$else WINCE}