* don't use the OS/2 API function DosSearchPath for searching through the list of directories in FSearch because it always returns full path even for relative directory specifications (as opposed to what is expected in TP/BP)

git-svn-id: trunk@29532 -

rtl/os2/dos.pas

@@ -105,18 +105,50 @@ begin
 end;
 
 
-function fsearch(path:pathstr;dirlist:string):pathstr;
-Var
-  A: array [0..255] of char;
-  D, P: AnsiString;
+function FSearch (Path: PathStr; DirList: string): PathStr;
+var
+  i,p1   : longint;
+  s      : searchrec;
+  newdir : pathstr;
 begin
-  P:=Path;
-  D:=DirList;
-  DosError := DosSearchPath (dsCurrentDir or dsIgnoreNetErrs, PChar(D),
-                                                            PChar(P), @A, 255);
-  if DosError <> 0 then
-   OSErrorWatch (DosError);
-  fsearch := StrPas (@A);
+{ check if the file specified exists }
+  findfirst(path,anyfile and not(directory),s);
+  if doserror=0 then
+   begin
+     findclose(s);
+     fsearch:=path;
+     exit;
+   end;
+{ 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 ['\',':'])) 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;
+    end;
+  findclose(s);
 end;