瀏覽代碼

* fixed driveletter checking

peter 26 年之前
父節點
當前提交
af73412d2b
共有 2 個文件被更改,包括 17 次插入7 次删除
  1. 9 5
      rtl/go32v2/dos.pp
  2. 8 2
      rtl/win32/dos.pp

+ 9 - 5
rtl/go32v2/dos.pp

@@ -742,22 +742,23 @@ end;
           if LFNSupport then
            begin
              pa:=path;
-             { Always uppercase driveletter }
-             if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['a'..'z']) then
-              pa[1]:=CHR(ORD(Pa[1])-32);
            end
           else
            if FileNameCaseSensitive then
             pa:=path
            else
             pa:=upcase(path);
+
           { allow slash as backslash }
           for i:=1 to length(pa) do
            if pa[i]='/' then
             pa[i]:='\';
 
-          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z']) then
+          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
             begin
+               { Always uppercase driveletter }
+               if (pa[1] in ['a'..'z']) then
+                pa[1]:=Chr(Ord(Pa[1])-32);
                { we must get the right directory }
                getdir(ord(pa[1])-ord('A')+1,s);
                i:=ioresult;
@@ -1005,7 +1006,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.8  1999-05-08 19:47:22  peter
+  Revision 1.9  1999-05-16 17:08:58  peter
+    * fixed driveletter checking
+
+  Revision 1.8  1999/05/08 19:47:22  peter
     * check ioresult after getdir calls
 
   Revision 1.7  1999/05/04 23:55:50  pierre

+ 8 - 2
rtl/win32/dos.pp

@@ -627,8 +627,11 @@ begin
     if pa[i]='/' then
      pa[i]:='\';
 
-   if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then
+   if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
      begin
+        { Always uppercase driveletter }
+        if (pa[1] in ['a'..'z']) then
+         pa[1]:=Chr(Ord(Pa[1])-32);
         { we must get the right directory }
         getdir(ord(pa[1])-ord('A')+1,s);
         if (ord(pa[0])>2) and (pa[3]<>'\') then
@@ -881,7 +884,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.16  1999-05-08 19:47:27  peter
+  Revision 1.17  1999-05-16 17:08:59  peter
+    * fixed driveletter checking
+
+  Revision 1.16  1999/05/08 19:47:27  peter
     * check ioresult after getdir calls
 
   Revision 1.15  1999/04/28 11:42:52  peter