From 17062d667c640b937f30a3600cd0c1ffaeacb6fa Mon Sep 17 00:00:00 2001 From: marco Date: Wed, 18 Nov 2009 18:04:51 +0000 Subject: [PATCH] * 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 | 45 +++++++++++--------------- rtl/inc/system.inc | 63 +++++++++++++++++++++++++++--------- rtl/inc/systemh.inc | 9 +++--- rtl/objpas/objpas.pp | 22 +++++++++++++ rtl/os2/sysdir.inc | 75 +++++++++++++++++++------------------------ rtl/unix/sysdir.inc | 43 ++++++++++--------------- rtl/win/sysdir.inc | 37 ++++++++++----------- 7 files changed, 161 insertions(+), 133 deletions(-) diff --git a/rtl/go32v2/sysdir.inc b/rtl/go32v2/sysdir.inc index bbfb1199f2..eb366417ac 100644 --- a/rtl/go32v2/sysdir.inc +++ b/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)); - buffer[length(s)]:=#0; - DoDirSeparators(pchar(@buffer)); + 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 (length(s)>0) and (buffer[length(s)-1]='\') and - Not ((length(s)=1) or ((length(s)=3) and (s[2]=':'))) then - buffer[length(s)-1]:=#0; - syscopytodos(longint(@buffer),length(s)+1); + 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); regs.realedx:=tb_offset; regs.realds:=tb_segment; if LFNSupport then @@ -44,35 +41,32 @@ begin GetInOutRes(lo(regs.realeax)); 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; - DosDir($39,s); + DosDir($39,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[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(const s : string);[IOCheck]; +Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR']; 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; diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index bf48c8e1be..6ee50ea1e3 100644 --- a/rtl/inc/system.inc +++ b/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 *****************************************************************************} diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 79355e76c6..0e17a5082a 100644 --- a/rtl/inc/systemh.inc +++ b/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 mkdir(const s:string); -Procedure rmdir(const s:string); +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 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 *****************************************************************************} diff --git a/rtl/objpas/objpas.pp b/rtl/objpas/objpas.pp index 56e44c126a..30b4a205cf 100644 --- a/rtl/objpas/objpas.pp +++ b/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 diff --git a/rtl/os2/sysdir.inc b/rtl/os2/sysdir.inc index f4c585c1c5..1476f17083 100644 --- a/rtl/os2/sysdir.inc +++ b/rtl/os2/sysdir.inc @@ -19,64 +19,57 @@ Directory Handling *****************************************************************************} -procedure MkDir (const S: string);[IOCHECK]; -var buffer:array[0..255] of char; +Procedure MkDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_MKDIR']; +var Rc : word; begin - If (s='') or (InOutRes <> 0) then - exit; - move(s[1],buffer,length(s)); - buffer[length(s)]:=#0; - DoDirSeparators(Pchar(@buffer)); - Rc := DosCreateDir(buffer,nil); - if Rc <> 0 then - begin - InOutRes := Rc; - Errno2Inoutres; - end; + If not assigned(s) or (len=0) or (InOutRes <> 0) then + exit; + DoDirSeparators(s); + Rc := DosCreateDir(s,nil); + if Rc <> 0 then + begin + InOutRes := Rc; + Errno2Inoutres; + end; end; - -procedure rmdir(const s : string);[IOCHECK]; -var buffer:array[0..255] of char; +Procedure RmDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_RMDIR']; +var Rc : word; begin - if (s = '.' ) then + if (len=1) and (s^ = '.' ) then InOutRes := 16; - If (s='') or (InOutRes <> 0) then - exit; - move(s[1],buffer,length(s)); - buffer[length(s)]:=#0; - DoDirSeparators(Pchar(@buffer)); - Rc := DosDeleteDir(buffer); - if Rc <> 0 then - begin - InOutRes := Rc; - Errno2Inoutres; - end; + If not assigned(s) or (len=0) or (InOutRes <> 0) then + exit; + DoDirSeparators(s); + Rc := DosDeleteDir(s); + if Rc <> 0 then + begin + InOutRes := Rc; + 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 (Length (S) >= 2) and (S [2] = ':') then + If not assigned(s) or (len=0) or (InOutRes <> 0) 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)); - Buffer [Length (S)] := #0; - DoDirSeparators (PChar (@Buffer)); - RC := DosSetCurrentDir (@Buffer); + DoDirSeparators (s); + RC := DosSetCurrentDir (s); if RC <> 0 then begin InOutRes := RC; @@ -84,10 +77,8 @@ begin end; end; end else begin - Move (S [1], Buffer, Length (S)); - Buffer [Length (S)] := #0; - DoDirSeparators (PChar (@Buffer)); - RC := DosSetCurrentDir (@Buffer); + DoDirSeparators (s); + RC := DosSetCurrentDir (s); if RC <> 0 then begin InOutRes:= RC; diff --git a/rtl/unix/sysdir.inc b/rtl/unix/sysdir.inc index d360b98aa7..202058df05 100644 --- a/rtl/unix/sysdir.inc +++ b/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 - exit; - Move(s[1], Buffer, Length(s)); - Buffer[Length(s)] := #0; - If Fpmkdir(@buffer[0], MODE_MKDIR)<0 Then + If not assigned(s) or (len=0) or (InOutRes <> 0) then + exit; + If Fpmkdir(s, MODE_MKDIR)<0 Then Errno2Inoutres Else InOutRes:=0; End; - -Procedure RmDir(Const s: String);[IOCheck]; -Var - Buffer: Array[0..255] of Char; +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 (s='') or (InOutRes <> 0) then - exit; - Move(s[1], Buffer, Length(s)); - Buffer[Length(s)] := #0; - If Fprmdir(@buffer[0])<0 Then + If not assigned(s) or (len=0) or (InOutRes <> 0) then + exit; + If Fprmdir(s)<0 Then Errno2Inoutres Else InOutRes:=0; End; - -Procedure ChDir(Const s: String);[IOCheck]; -Var - Buffer: Array[0..255] of Char; +Procedure ChDir(s: pchar;len:sizeuint);[IOCheck, public, alias : 'FPC_SYS_CHDIR']; 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)); - Buffer[Length(s)] := #0; - If Fpchdir(@buffer[0])<0 Then + If Fpchdir(s)<0 Then Errno2Inoutres Else InOutRes:=0; diff --git a/rtl/win/sysdir.inc b/rtl/win/sysdir.inc index d0ed123ef6..6c59a290f6 100644 --- a/rtl/win/sysdir.inc +++ b/rtl/win/sysdir.inc @@ -17,18 +17,13 @@ {***************************************************************************** Directory Handling *****************************************************************************} - type TDirFnType=function(name:pointer):longbool;stdcall; -procedure dirfn(afunc : TDirFnType;const s:string); -var - buffer : array[0..255] of char; +procedure dirfn(afunc : TDirFnType;s:pchar;len:integer); begin - move(s[1],buffer,length(s)); - buffer[length(s)]:=#0; - DoDirSeparators(pchar(@buffer)); - if not aFunc(@buffer) then + DoDirSeparators(s); + if not aFunc(s) 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 - exit; - dirfn(TDirFnType(@RemoveDirectory),s); + dirfn(TDirFnType(@RemoveDirectory),s,len); {$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}