瀏覽代碼

* changed getdir(ansistring):ansistring to
getdir(rawbytestring):rawbytestring so it can accept strings in any
encoding and cleanly return results in DefaultRTLFileSystemCodePage
+ getdir(unicodestring):unicodestring
* renamed the getdir implementation of all platforms except for embedded-
without-ansistring-support to do_getdir(), and depending on the
FPCRTL_FILESYSTEM_SINGLE_BYTE_API/FPCRTL_FILESYSTEM_TWO_BYTE_API define
changed its shortstring parameter to ansistring or unicodestring. The
do_getdir(rawbytestring) routine should just set the code page of the
return value to DefaultFileSystemCodePage without conversion (not
DefaultRTLFileSystemCodePage with conversion, that conversion is performed
in getdir if necessary; this avoids double conversions in case
getdir(unicodestring) is called)
+ generic getdir(shortstring) for platforms supporting either ansistrings or widestrings
o platform maintainers:
o OS/2: adjust code to supports paths > 255 characters if those are supported
o Wii: adjust used callback to use rawbytestring to support paths > 255 characters and
avoid shortstring->rawbytestring conversion overhead
o Windows: GetCurrentDirectoryW is now always used (to prevent data loss)

git-svn-id: branches/cpstrrtl@24993 -

Jonas Maebe 12 年之前
父節點
當前提交
62ee16278b

+ 5 - 2
rtl/amiga/sysdir.inc

@@ -88,7 +88,7 @@ begin
   sys_chdir(s);
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 var tmpbuf: array[0..255] of char;
 begin
   checkCTRLC;
@@ -97,5 +97,8 @@ begin
   if not GetCurrentDirName(tmpbuf,256) then
     dosError2InOut(IoErr)
   else
-    Dir:=strpas(tmpbuf);
+    begin
+      Dir:=tmpbuf;
+      SetCodePage(Dir,DefaultFileSystemCodePage,false);
+    end;
 end;

+ 4 - 0
rtl/embedded/sysdir.inc

@@ -34,7 +34,11 @@ begin
   InOutRes:=3;
 end;
 
+{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+{$else FPC_HAS_FEATURE_ANSISTRINGS}
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
 begin
   InOutRes:=3;
 end;

+ 5 - 4
rtl/emx/sysdir.inc

@@ -163,7 +163,7 @@ end;
 
 {$ASMMODE ATT}
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 
 {Written by Michael Van Canneyt.}
 
@@ -171,6 +171,7 @@ var sof:Pchar;
     i:byte;
 
 begin
+    SetLength(Dir,260);
     Dir [4] := #0;
     { Used in case the specified drive isn't available }
     sof:=pchar(@dir[4]);
@@ -189,7 +190,6 @@ begin
     end [ 'eax','edx','esi'];
     { Now Dir should be filled with directory in ASCIIZ, }
     { starting from dir[4]                               }
-    dir[0]:=#3;
     dir[2]:=':';
     dir[3]:='\';
     i:=4;
@@ -199,10 +199,9 @@ begin
             { convert path name to DOS }
 			     if dir[i] in AllowDirectorySeparators then
 			       dir[i]:=DirectorySeparator;
-            dir[0]:=char(i);
             inc(i);
         end;
-    { upcase the string (FPC function) }
+    SetLength(dir,i-1);
     if drivenr<>0 then   { Drive was supplied. We know it }
         dir[1]:=chr(64+drivenr)
     else
@@ -217,5 +216,7 @@ begin
             end ['eax'];
             dir[1]:=char(i);
         end;
+    SetCodePage(dir,DefaultFileSystemCodePage,false);
+    { upcase the string (FPC function) }
     if not (FileNameCasePreserving) then dir:=upcase(dir);
 end;

+ 1 - 1
rtl/gba/sysdir.inc

@@ -34,7 +34,7 @@ begin
 
 end;
 
-procedure GetDir(DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir(DriveNr: byte; var Dir: RawByteString);
 begin
 
 end;

+ 5 - 2
rtl/go32v2/sysdir.inc

@@ -85,7 +85,7 @@ begin
   DosDir($3b,s,len);
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 var
   temp : array[0..255] of char;
   i    : longint;
@@ -103,12 +103,14 @@ begin
    Begin
      GetInOutRes (lo(regs.realeax));
      Dir := char (DriveNr + 64) + ':\';
+     SetCodePage (Dir,DefaultFileSystemCodePage,false);
      exit;
    end
   else
    syscopyfromdos(longint(@temp),251);
 { conversion to Pascal string including slash conversion }
   i:=0;
+  SetLength(dir,260);
   while (temp[i]<>#0) do
    begin
      if temp[i] in AllowDirectorySeparators then
@@ -118,7 +120,8 @@ begin
    end;
   dir[2]:=':';
   dir[3]:='\';
-  dir[0]:=char(i+3);
+  SetLength(dir,i+3);
+  SetCodePage(dir,DefaultFileSystemCodePage,false);
 { upcase the string }
   if not FileNameCasePreserving then
    dir:=upcase(dir);

+ 62 - 13
rtl/inc/system.inc

@@ -1503,20 +1503,12 @@ end;
 {$i sysdir.inc}
 {$endif FPC_HAS_FEATURE_FILEIO}
 
-{$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;
@@ -1549,7 +1541,64 @@ Begin
   Buffer[Length(s)] := #0;
   ChDir(@buffer[0],length(s));
 End;
-{$endif}
+
+{$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
+  Do_getdir(drivenr,dir);
+  { we should return results in the DefaultRTLFileSystemCodePage -> convert if
+    necessary }
+  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 }
+Procedure getdir(drivenr:byte;Var dir:shortstring);
+var
+  s: rawbytestring;
+begin
+  Do_getdir(drivenr,s);
+  if length(s)<=high(dir) then
+    dir:=s
+  else
+    inoutres:=3;
+end;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
+
+{$if defined(FPC_HAS_FEATURE_WIDESTRINGS)}
+
+{$ifndef FPCRTL_FILESYSTEM_TWO_BYTE_API}
+procedure do_getdir(drivenr : byte;var dir : unicodestring);
+var
+  s: rawbytestring;
+begin
+  Do_getdir(drivenr,s);
+  dir:=s;
+end;
+{$endif FPCRTL_FILESYSTEM_TWO_BYTE_API}
+
+
+Procedure getdir(drivenr:byte;Var dir:unicodestring);
+begin
+  Do_getdir(drivenr,dir);
+end;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
+{$endif FPC_HAS_FEATURE_FILEIO}
+
 
 {*****************************************************************************
                             Resources support

+ 7 - 2
rtl/inc/systemh.inc

@@ -1185,10 +1185,15 @@ 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);
+Procedure getdir(drivenr:byte;var dir:shortstring);overload;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Procedure getdir(drivenr:byte;var dir:ansistring);
+// 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 getdir(drivenr:byte;var dir: unicodestring);overload;
+{$endif FPC_HAS_FEATURE_WIDESTRINGS}
+
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 {*****************************************************************************

+ 3 - 9
rtl/macos/sysdir.inc

@@ -98,22 +98,16 @@ begin
     InOutRes:=res;
 end;
 
-procedure getDir (DriveNr: byte; var Dir: ShortString);
+procedure do_getDir (DriveNr: byte; var Dir: RawByteString);
 
 var
-  fullPath: AnsiString;
   pathHandleSize: Longint;
 
 begin
-  if FSpGetFullPath(workingDirectorySpec, fullPath, false) <> noErr then
+  if FSpGetFullPath(workingDirectorySpec, Dir, false) <> noErr then
     Halt(3);  {exit code 3 according to MPW}
 
-  if Length(fullPath) <= 255 then {because dir is ShortString}
-    InOutRes := 0
-  else
-    InOutRes := 1; //TODO Exchange to something better
-
-  dir:= fullPath;
+  SetCodePage(Dir,DefaultFileSystemCodePage,false);
 end;
 
 

+ 5 - 2
rtl/morphos/sysdir.inc

@@ -83,7 +83,7 @@ begin
   if assigned(FIB) then dispose(FIB);
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 var tmpbuf: array[0..255] of char;
 begin
   checkCTRLC;
@@ -91,5 +91,8 @@ begin
   if not GetCurrentDirName(tmpbuf,256) then
     dosError2InOut(IoErr)
   else
-    Dir:=strpas(tmpbuf);
+    begin
+      Dir:=tmpbuf;
+      SetCodePage(Dir,DefaultFileSystemCodePage,false);
+    end;
 end;

+ 5 - 2
rtl/msdos/sysdir.inc

@@ -84,7 +84,7 @@ begin
   DosDir($3b,s,len);
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure GetDir (DriveNr: byte; var Dir: RawByteString);
 var
   temp : array[0..260] of char;
   i    : longint;
@@ -102,12 +102,14 @@ begin
    Begin
      GetInOutRes (regs.AX);
      Dir := char (DriveNr + 64) + ':\';
+     SetCodePage (Dir,DefaultFileSystemCodePage,false);
      exit;
    end
   else
     temp[252] := #0;  { to avoid shortstring buffer overflow }
 { conversion to Pascal string including slash conversion }
   i:=0;
+  SetLength(dir,260);
   while (temp[i]<>#0) do
    begin
      if temp[i] in AllowDirectorySeparators then
@@ -117,7 +119,8 @@ begin
    end;
   dir[2]:=':';
   dir[3]:='\';
-  dir[0]:=char(i+3);
+  SetLength(dir,i+3);
+  SetCodePage (dir,DefaultFileSystemCodePage,false);
 { upcase the string }
   if not FileNameCasePreserving then
    dir:=upcase(dir);

+ 1 - 1
rtl/nativent/sysdir.inc

@@ -121,7 +121,7 @@ begin
   InOutRes := 3;
 end;
 
-procedure GetDir(DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir(DriveNr: byte; var Dir: UnicodeString);
 begin
   { for now we return simply the root directory }
   Dir := DirectorySeparator;

+ 1 - 1
rtl/nds/sysdir.inc

@@ -37,7 +37,7 @@ begin
 
 end;
 
-procedure GetDir(DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir(DriveNr: byte; var Dir: RawByteString);
 begin
 
 end;

+ 3 - 2
rtl/netware/sysdir.inc

@@ -54,7 +54,7 @@ begin
     SetFileError(Rc);
 end;
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 VAR P : ARRAY [0..255] OF CHAR;
     i : LONGINT;
 begin
@@ -63,8 +63,8 @@ begin
   i := _strlen (P);
   if i > 0 then
   begin
+    SetLength (dir, i);
     Move (P, dir[1], i);
-    BYTE(dir[0]) := i;
     DoDirSeparators(dir);
     // fix / after volume, the compiler needs that
     // normaly root of a volumes is SERVERNAME/SYS:, change that
@@ -73,6 +73,7 @@ begin
     if (i > 0) then
       if i = Length (dir) then dir := dir + '/' else
       if dir [i+1] <> '/' then insert ('/',dir,i+1);
+    SetCodePage (dir,DefaultFileSystemCodePage,false);
   END ELSE
     InOutRes := 1;
 end;

+ 3 - 2
rtl/netwlibc/sysdir.inc

@@ -48,7 +48,7 @@ begin
     SetFileError (Res);
 end;
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 var P : array [0..255] of CHAR;
     i : LONGINT;
 begin
@@ -57,8 +57,8 @@ begin
   i := libc_strlen (P);
   if i > 0 then
   begin
+    SetLength (dir, i);
     Move (P, dir[1], i);
-    BYTE(dir[0]) := i;
     DoDirSeparators(dir);
     // fix / after volume, the compiler needs that
     // normaly root of a volumes is SERVERNAME/SYS:, change that
@@ -67,6 +67,7 @@ begin
     if (i > 0) then
       if i = Length (dir) then dir := dir + '/' else
       if dir [i+1] <> '/' then insert ('/',dir,i+1);
+    SetCodePage (dir,DefaultFileSystemCodePage,false);
   end else
     InOutRes := 1;
 end;

+ 6 - 3
rtl/os2/sysdir.inc

@@ -89,12 +89,13 @@ end;
 
 {$ASMMODE ATT}
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 {Written by Michael Van Canneyt.}
 var sof: Pchar;
     i:byte;
     l,l2:cardinal;
 begin
+    setlength(Dir,255);
     Dir [4] := #0;
     { Used in case the specified drive isn't available }
     sof:=pchar(@dir[4]);
@@ -102,12 +103,13 @@ begin
     { supplied by DOS, so we let dos string start at   }
     { dir[4]                                           }
     { Get dir from drivenr : 0=default, 1=A etc... }
+    { TODO: if max path length is > 255, increase the setlength parameter above and
+      the 255 below }
     l:=255-3;
     InOutRes:=longint (DosQueryCurrentDir(DriveNr, sof^, l));
 {$WARNING Result code should be translated in some cases!}
     { Now Dir should be filled with directory in ASCIIZ, }
     { starting from dir[4]                               }
-    dir[0]:=#3;
     dir[2]:=':';
     dir[3]:='\';
     i:=4;
@@ -117,9 +119,9 @@ begin
             { convert path name to DOS }
             if dir[i] in AllowDirectorySeparators then
               dir[i]:=DirectorySeparator;
-            dir[0]:=char(i);
             inc(i);
         end;
+    setlength(dir,i-1);
     { upcase the string (FPC function) }
     if drivenr<>0 then   { Drive was supplied. We know it }
         dir[1]:=chr(64+drivenr)
@@ -130,6 +132,7 @@ begin
             DosQueryCurrentDisk(l, l2);
             dir[1]:=chr(64+l);
         end;
+    SetCodePage(dir,DefaultFileSystemCodePage,false);
     if not (FileNameCasePreserving) then dir:=upcase(dir);
 end;
 

+ 1 - 1
rtl/symbian/sysdir.inc

@@ -32,7 +32,7 @@ begin
 
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 begin
 
 end;

+ 31 - 13
rtl/unix/sysdir.inc

@@ -70,26 +70,32 @@ End;
 // !! In the libc versions, the alt code is already integrated in the libc code.
 // !! Also significantly boosted buffersize. This will make failure of the 
 // !! dos legacy api's better visibile due to cut-off path, instead of "empty"
-procedure getdir(drivenr : byte;var dir : shortstring);
+
+
+procedure do_getdir(drivenr : byte;var dir : rawbytestring);
 var
   buf          : array[0..2047] of char;
+{$ifndef FPC_USE_LIBC}
   cwdinfo      : stat;
   rootinfo     : stat;
-  thedir,dummy : string[255];
+  thedir,dummy : rawbytestring;
   dirstream    : pdir;
   d            : pdirent;
-  name         : string[255];
   thisdir      : stat;
-  tmp          : string[255];
-
+  tmp          : rawbytestring;
+{$endif FPC_USE_LIBC}
 begin
   dir:='';
  if Fpgetcwd(@buf[0],sizeof(buf))<>nil then
-   dir:=strpas(buf)
+   begin
+     dir:=buf;
+     { the returned result by the OS is in the DefaultFileSystemCodePage ->
+       no conversion }
+     setcodepage(dir,DefaultFileSystemCodePage,false);
+   end
 {$ifndef FPC_USE_LIBC}
  else 
   begin
-  thedir:='';
   dummy:='';
 
   { get root directory information }
@@ -108,12 +114,12 @@ begin
     if dirstream=nil then
        exit;
     repeat
-      name:='';
+      thedir:='';
       d:=Fpreaddir(dirstream);
       { no more entries to read ... }
       if not assigned(d) then
         break;
-      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
+      tmp:=dummy+'../'+d^.d_name + #0;
       if (Fpstat(@tmp[1],thisdir)=0) then
        begin
          { found the entry for this directory name }
@@ -123,20 +129,32 @@ begin
             { then do not set the name.               }
             if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
                     ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
-              name:='/'+strpas(d^.d_name);
+              { d^.d_name is an array[0..x] of char -> will be assigned the
+                ansi code page on conversion to ansistring -> also typecast
+                '/' to ansistring rather than rawbytestring so code pages match
+                (will be unconditionally set to DefaultFileSystemCodePage at
+                 the end without conversion) }
+              thedir:=ansistring('/')+d^.d_name;
           end;
        end;
-    until (name<>'');
+    until (thedir<>'');
     if Fpclosedir(dirstream)<0 then
       Exit;
-    thedir:=name+thedir;
     dummy:=dummy+'../';
     if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
       begin
         if thedir='' then
           dir:='/'
         else
-          dir:=thedir;
+          begin
+            dir:=thedir;
+            { try to ensure that "dir" has a refcount of 1, so that setcodepage
+              doesn't have to create a deep copy }
+            thedir:='';
+          end;
+        { the returned result by the OS is in the DefaultFileSystemCodePage ->
+          no conversion }
+        setcodepage(dir,DefaultFileSystemCodePage,false);
         exit;
       end;
   until false;

+ 5 - 2
rtl/watcom/sysdir.inc

@@ -76,7 +76,7 @@ begin
 end;
 
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+procedure do_getdir(drivenr : byte;var dir : RawByteString);
 var
   temp : array[0..255] of char;
   i    : longint;
@@ -94,12 +94,14 @@ begin
    Begin
      GetInOutRes(lo(regs.realeax));
      Dir := char (DriveNr + 64) + ':\';
+     SetCodePage(dir,DefaultFileSystemCodePage,false);
      exit;
    end
   else
    syscopyfromdos(longint(@temp),251);
 { conversion to Pascal string including slash conversion }
   i:=0;
+  SetLength(Dir,255);
   while (temp[i]<>#0) do
    begin
      if temp[i] in AllowDirectorySeparators then
@@ -109,7 +111,8 @@ begin
    end;
   dir[2]:=':';
   dir[3]:='\';
-  dir[0]:=char(i+3);
+  SetLength(Dir,i+3);
+  SetCodePage(dir,DefaultFileSystemCodePage,false);
 { upcase the string }
   if not FileNameCasePreserving then
    dir:=upcase(dir);

+ 9 - 2
rtl/wii/sysdir.inc

@@ -39,10 +39,17 @@ begin
     FileIODevice.DirIO.DoChdir(strpas(s));
 end;
 
-procedure GetDir(DriveNr: byte; var Dir: ShortString);
+procedure GetDir(DriveNr: byte; var Dir: RawByteString);
+var
+  TmpDir: ShortString;
 begin
+  { TODO: convert callback to use rawbytestring to avoid conversion }
   if FileIODevice.DirIO.DoGetdir <> nil then
-    FileIODevice.DirIO.DoGetdir(DriveNr, Dir);
+    begin
+      FileIODevice.DirIO.DoGetdir(DriveNr, Dir);
+      Dir:=TmpDir;
+      SetCodePage(Dir,DefaultFileSystemCodePage,false);
+    end;
 end;
 
 

+ 15 - 9
rtl/win/sysdir.inc

@@ -74,38 +74,44 @@ begin
 {$endif WINCE}
 end;
 
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
+procedure do_GetDir (DriveNr: byte; var Dir: Unicodestring);
 {$ifndef WINCE}
 var
   Drive:array[0..3]of char;
   defaultdrive:boolean;
-  DirBuf,SaveBuf:array[0..259] of Char;
+  savebuf: UnicodeString;
+  len : integer;
 {$endif WINCE}
 begin
 {$ifndef WINCE}
   defaultdrive:=drivenr=0;
   if not defaultdrive then
    begin
-    byte(Drive[0]):=Drivenr+64;
+    Drive[0]:=widechar(Drivenr+64);
     Drive[1]:=':';
     Drive[2]:=#0;
     Drive[3]:=#0;
-    GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
+    len:=GetCurrentDirectoryW(0,nil); // in TChar
+    setlength(savebuf,len-1); // -1 because len is #0 inclusive
+
+    GetCurrentDirectoryW(len,punicodechar(SaveBuf)); // in TChar
     if not SetCurrentDirectory(@Drive) then
      begin
       errno := word (GetLastError);
       Errno2InoutRes;
-      Dir := char (DriveNr + 64) + ':\';
+      Dir := widechar (DriveNr + 64) + ':\';
       SetCurrentDirectory(@SaveBuf);
       Exit;
      end;
    end;
-  GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
+
+  len:=GetCurrentDirectoryW(0,nil);
+  setlength(dir,len-1); // -1 because len is #0 inclusive
+  GetCurrentDirectoryW(len,punicodechar(dir));
   if not defaultdrive then
-   SetCurrentDirectory(@SaveBuf);
-  dir:=strpas(DirBuf);
+    SetCurrentDirectory(@SaveBuf);
   if not FileNameCasePreserving then
-   dir:=upcase(dir);
+    dir:=upcase(dir);
 {$else WINCE}
   Dir:='\';
 {$endif WINCE}

+ 2 - 5
rtl/win/sysos.inc

@@ -298,9 +298,6 @@ threadvar
      stdcall;external KernelDLL name 'RemoveDirectoryW';
    function SetCurrentDirectory(name : pointer) : longbool;
      stdcall;external KernelDLL name 'SetCurrentDirectoryW';
-   function GetCurrentDirectory(bufsize : longint;name : punicodechar) : longbool;
-     stdcall;external KernelDLL name 'GetCurrentDirectoryW';
-
    {$else}
    function GetFileAttributes(p : pchar) : dword;
      stdcall;external KernelDLL name 'GetFileAttributesA';
@@ -319,10 +316,10 @@ threadvar
      stdcall;external KernelDLL name 'RemoveDirectoryA';
    function SetCurrentDirectory(name : pointer) : longbool;
      stdcall;external KernelDLL name 'SetCurrentDirectoryA';
-   function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
-     stdcall;external KernelDLL name 'GetCurrentDirectoryA';
 
   {$endif}
+   function GetCurrentDirectoryW(bufsize : longint;name : punicodechar) : Dword;
+     stdcall;external KernelDLL name 'GetCurrentDirectoryW';
 
    { Console functions needed for WriteFile fix for bug 17550 }
    function GetConsoleMode(hConsoleHandle:thandle; lpMode:LPDWORD):BOOL;