* error code fixes

rtl/win32/dos.pp

@@ -583,6 +583,8 @@ begin
      if not FindNextFile (F.FindHandle,F.W32FindData) then
       begin
         DosError:=Last2DosError(GetLastError);
+        if DosError=2 then
+         DosError:=18;
         exit;
       end;
    end;
@@ -607,6 +609,8 @@ begin
   If longint(F.FindHandle)=Invalid_Handle_value then
    begin
      DosError:=Last2DosError(GetLastError);
+     if DosError=2 then
+      DosError:=18;
      exit;
    end;
 { Find file with correct attribute }
@@ -621,6 +625,8 @@ begin
   if not FindNextFile (F.FindHandle,F.W32FindData) then
    begin
      DosError:=Last2DosError(GetLastError);
+     if DosError=2 then
+      DosError:=18;
      exit;
    end;
 { Find file with correct attribute }
@@ -812,11 +818,15 @@ procedure getftime(var f;var time : longint);
 var
    ft : TFileTime;
 begin
+  doserror:=0;
   if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
      WinToDosTime(ft,time) then
     exit
   else
-    time:=0;
+    begin
+      DosError:=Last2DosError(GetLastError);
+      time:=0;
+    end;
 end;
 
 
@@ -824,9 +834,12 @@ procedure setftime(var f;time : longint);
 var
   ft : TFileTime;
 begin
-  if DosToWinTime(time,ft) then
+  doserror:=0;
-   if not SetFileTime(filerec(f).Handle,nil,nil,@ft) then;
+  if DosToWinTime(time,ft) and
-  DosError:=Last2DosError(GetLastError);
+     SetFileTime(filerec(f).Handle,nil,nil,@ft) then
+   exit
+  else
+   DosError:=Last2DosError(GetLastError);
 end;
 
 
@@ -1037,7 +1050,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2002-12-15 20:23:53  peter
+  Revision 1.18  2002-12-24 15:35:15  peter
+    * error code fixes
+
+  Revision 1.17  2002/12/15 20:23:53  peter
     * map error 87 to 13 to be compatible with dos
 
   Revision 1.16  2002/12/04 21:35:50  carl

rtl/win32/system.pp

@@ -161,6 +161,8 @@ CONST
 {   A pipe has been closed on the other end }
 {   Removing that error allows eof to works as on other OSes }
     ERROR_BROKEN_PIPE = 109;
+    ERROR_DIR_NOT_EMPTY = 145;
+    ERROR_ALREADY_EXISTS = 183;
 
 {$IFDEF SUPPORT_THREADVAR}
 threadvar
@@ -188,21 +190,25 @@ var
    Procedure Errno2InOutRes;
    Begin
      { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }
-     if (errno >= ERROR_WRITE_PROTECT) and (errno <= ERROR_GEN_FAILURE) THEN
+     case Errno of
-       BEGIN
+       ERROR_WRITE_PROTECT..ERROR_GEN_FAILURE :
-          { This is the offset to the Win32 to add to directly map  }
+         begin
-          { to the DOS/TP compatible error codes when in this range }
+           { This is the offset to the Win32 to add to directly map  }
-          InOutRes := word(errno)+131;
+           { to the DOS/TP compatible error codes when in this range }
-       END
+           InOutRes := word(errno)+131;
-     else
+         end;
-     { This case is special }
+       ERROR_DIR_NOT_EMPTY,
-     if errno=ERROR_SHARING_VIOLATION THEN
+       ERROR_ALREADY_EXISTS,
-       BEGIN
+       ERROR_SHARING_VIOLATION :
-         InOutRes :=5;
+         begin
-       END
+           InOutRes :=5;
-     else
+         end;
-     { other error codes can directly be mapped }
+       else
-         InOutRes := Word(errno);
+         begin
+           { other error codes can directly be mapped }
+           InOutRes := Word(errno);
+         end;
+     end;
      errno:=0;
    end;
 
@@ -307,7 +313,8 @@ end;
      external 'kernel32' name 'SetEndOfFile';
    function GetFileType(Handle:DWORD):DWord;
      external 'kernel32' name 'GetFileType';
-
+   function GetFileAttributes(p : pchar) : dword;
+     external 'kernel32' name 'GetFileAttributesA';
 
 procedure AllowSlash(p:pchar);
 var
@@ -338,6 +345,11 @@ begin
    if DeleteFile(p)=0 then
     Begin
       errno:=GetLastError;
+      if errno=5 then
+       begin
+         if (GetFileAttributes(p)=FILE_ATTRIBUTE_DIRECTORY) then
+          errno:=2;
+       end;
       Errno2InoutRes;
     end;
 end;
@@ -623,6 +635,8 @@ begin
   If (s='') or (InOutRes <> 0) then
    exit;
   dirfn(TDirFnType(@SetCurrentDirectory),s);
+  if Inoutres=2 then
+   Inoutres:=3;
 end;
 
 procedure GetDir (DriveNr: byte; var Dir: ShortString);
@@ -1505,7 +1519,10 @@ end.
 
 {
   $Log$
-  Revision 1.38  2002-12-07 13:58:45  carl
+  Revision 1.39  2002-12-24 15:35:15  peter
+    * error code fixes
+
+  Revision 1.38  2002/12/07 13:58:45  carl
     * fix warnings
 
   Revision 1.37  2002/11/30 18:17:35  carl