* fix for bug #24504 (extended version of patch by Bart Broersma)

git-svn-id: trunk@34849 -

rtl/emx/dos.pas

@@ -145,7 +145,7 @@ procedure syscall;external name '___SYSCALL';
 
 function fsearch(path:pathstr;dirlist:string):pathstr;
 
-var i,p1:longint;
+var p1:longint;
     newdir:pathstr;
 
 {$ASMMODE INTEL}
@@ -169,40 +169,40 @@ end ['eax', 'ecx', 'edx'];
 {$ASMMODE ATT}
 
 begin
+{ No wildcards allowed in these things }
+    if (Pos ('?', Path) <> 0) or (Pos ('*', Path) <> 0) then
+        begin
+            FSearch := '';
+            Exit;
+        end;
 { check if the file specified exists }
     if CheckFile (Path + #0) then
         FSearch := Path
     else
         begin
-            {No wildcards allowed in these things:}
-            if (pos('?',path)<>0) or (pos('*',path)<>0) then
-                fsearch:=''
-            else
-                begin
-                    { allow slash as backslash }
-                    DoDirSeparators(dirlist);
-                    repeat
-                        p1:=pos(';',dirlist);
-                        if p1<>0 then
-                            begin
-                                newdir:=copy(dirlist,1,p1-1);
-                                delete(dirlist,1,p1);
-                            end
-                        else
-                            begin
-                                newdir:=dirlist;
-                                dirlist:='';
-                            end;
-                        if (newdir<>'') and
-                         not (newdir[length(newdir)] in AllowDirectorySeparators+AllowDriveSeparators) then
-                            newdir:=newdir+DirectorySeparator;
-                        if CheckFile (NewDir + Path + #0) then
-                            NewDir := NewDir + Path
-                        else
-                            NewDir := '';
-                    until (DirList = '') or (NewDir <> '');
-                    FSearch := NewDir;
-                end;
+            { allow slash as backslash }
+            DoDirSeparators(dirlist);
+            repeat
+                p1:=pos(';',dirlist);
+                if p1<>0 then
+                    begin
+                        newdir:=copy(dirlist,1,p1-1);
+                        delete(dirlist,1,p1);
+                    end
+                else
+                    begin
+                        newdir:=dirlist;
+                        dirlist:='';
+                    end;
+                if (newdir<>'') and
+                      not (newdir[length(newdir)] in AllowDirectorySeparators+DriveSeparator) then
+                    newdir:=newdir+DirectorySeparator;
+                if CheckFile (NewDir + Path + #0) then
+                    NewDir := NewDir + Path
+                else
+                    NewDir := '';
+            until (DirList = '') or (NewDir <> '');
+            FSearch := NewDir;
         end;
 end;
 

rtl/go32v2/dos.pp

@@ -983,48 +983,48 @@ end;
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  i,p1   : longint;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-{ check if the file specified exists }
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
   findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
+    begin
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/msdos/dos.pp

@@ -765,48 +765,48 @@ end;
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  p1     : integer;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-{ check if the file specified exists }
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
   findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
+    begin
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+    newdir:=newdir+'\';
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/netware/dos.pp

@@ -352,49 +352,48 @@ end;
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  i,p1   : longint;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-  write ('FSearch ("',path,'","',dirlist,'"');
-{ check if the file specified exists }
-  findfirst(path,anyfile,s);
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
+  findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow backslash as slash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
+    begin
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
     begin
-       { allow backslash as slash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
-          newdir:=newdir+'/';
-         findfirst(newdir+path,anyfile,s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/netwlibc/dos.pp

@@ -454,48 +454,48 @@ end;
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  i,p1   : longint;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-{ check if the file specified exists }
-  findfirst(path,anyfile,s);
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
+  findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow backslash as slash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
+    begin
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
     begin
-       { allow backslash as slash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
-          newdir:=newdir+'/';
-         findfirst(newdir+path,anyfile,s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/os2/dos.pas

@@ -106,50 +106,50 @@ begin
 end;
 
 
-function FSearch (Path: PathStr; DirList: string): PathStr;
+Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  i,p1   : longint;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-{ check if the file specified exists }
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
   findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
+    begin
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/watcom/dos.pp

@@ -631,48 +631,48 @@ end;
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  i,p1   : longint;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-{ check if the file specified exists }
-  findfirst(path,anyfile,s);
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
+  findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile,s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
+    begin
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/win/dos.pp

@@ -554,44 +554,44 @@ var
   s      : searchrec;
   newdir : pathstr;
 begin
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
   { check if the file specified exists }
   findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-  { No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
+    begin
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/win16/dos.pp

@@ -800,48 +800,48 @@ end;}
 
 Function FSearch(path: pathstr; dirlist: string): pathstr;
 var
-  p1     : integer;
+  p1     : longint;
   s      : searchrec;
   newdir : pathstr;
 begin
-{ check if the file specified exists }
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
+  { check if the file specified exists }
   findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
+    begin
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 

rtl/wince/dos.pp

@@ -410,44 +410,44 @@ var
   s      : searchrec;
   newdir : pathstr;
 begin
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+  begin
+    fsearch:='';
+    exit;
+  end;
   { check if the file specified exists }
   findfirst(path,anyfile and not(directory),s);
   if doserror=0 then
-   begin
+    begin
      findclose(s);
      fsearch:=path;
      exit;
-   end;
-  { No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
+    end;
+  { allow slash as backslash }
+  DoDirSeparators(dirlist);
+ repeat
+   p1:=pos(';',dirlist);
+   if p1<>0 then
+    begin
+      newdir:=copy(dirlist,1,p1-1);
+      delete(dirlist,1,p1);
+    end
+   else
     begin
-       { allow slash as backslash }
-       DoDirSeparators(dirlist);
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
+      newdir:=dirlist;
+      dirlist:='';
     end;
-  findclose(s);
+   if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator,DriveSeparator])) then
+    newdir:=newdir+DirectorySeparator;
+   findfirst(newdir+path,anyfile and not(directory),s);
+   if doserror=0 then
+    newdir:=newdir+path
+   else
+    newdir:='';
+   findclose(s);
+ until (dirlist='') or (newdir<>'');
+ fsearch:=newdir;
 end;
 
 { </immobilizer> }