home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1318 / gepackt.exe / BATUTIL / SOURCE / FILEDIR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1993-12-19  |  1.7 KB  |  57 lines
  1. {$m 10000,0,5000}
  2. program file_dir;
  3.  
  4.   uses
  5.     ufiledir;
  6.  
  7.   begin
  8.     filedir;
  9.   end.
  10.  
  11.   uses
  12.     dos,uenv,fdisks,upath,uexist;
  13.  
  14.   var
  15.     b                                  : byte;
  16.     s                                  : string;
  17.     fn,path                            : string;
  18.  
  19.   begin
  20.     if paramcount=0 then exit;
  21.     s:=paramstr(1);
  22.     fn:=getfilename(s);
  23.     path:=getpathname(s);
  24.     if path='' then begin
  25.       b:=pos('.*',fn);
  26.       if b>0 then fn[0]:=chr(pred(b));
  27.       if pos('.',fn)=0 then begin
  28.         s:=getpathname(fsearch(fn+'.exe',getenv('path')));
  29.         if s='' then s:=getpathname(fsearch(fn+'.com',getenv('path')));
  30.       end
  31.       else s:=getpathname(fsearch(fn,getenv('path')))
  32.     end
  33.     else begin
  34.       b:=1;
  35.       if (s[0]>#1) and (s[2]=':') then delete(s,1,2);
  36.       if (s<>'') and (s[1]<>'\') then s:='\'+s;
  37.       s:=':'+s;
  38.       if s<>'' then while (b<=lastdisk) and not exist(disks[b]+s,existfile) do inc(b);
  39.       if b<=lastdisk then s:=getpathname(disks[b]+s)
  40.       else begin
  41.         b:=1;
  42.         if s<>'' then while (b<=lastdisk) and not exist(disks[b]+s+'.exe',existfile) do inc(b);
  43.         if b<=lastdisk then s:=getpathname(disks[b]+s+'.exe')
  44.         else begin
  45.           b:=1;
  46.           if s<>'' then while (b<=lastdisk) and not exist(disks[b]+s+'.com',existfile) do inc(b);
  47.           if b<=lastdisk then s:=getpathname(disks[b]+s+'.com');
  48.         end;
  49.       end;
  50.     end;
  51.     if (s<>'') and (s[1]=':') then s:='';
  52.     if s[ord(s[0])]='\' then dec(s[0]);
  53.     if s<>'' then if paramcount>2 then s:=s+'\'+fn;
  54.     if paramcount>1 then halt(ord(not sethauptenv(paramstr(2)+'='+s)))
  55.     else halt(ord(not sethauptenv('what='+s)));
  56.   end.
  57.