home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILEFIND.ZIP / FILEFIND.INC
Encoding:
Text File  |  1989-03-20  |  3.3 KB  |  156 lines
  1. (************************************************************
  2.  * This program can be used to find any files using the     *
  3.  * set PATH, so you can open and use your TURBO *.COM       *
  4.  * programs together with their data files from any         *
  5.  * subdirectory, if they are located in a PATH-directory.   *
  6.  *          (TURBO cannot find it's MSGs, tsk tsk)          *
  7.  * Uploaded by Wolfgang Siebeck, Aachen W.Germany 72446,415 *
  8.  *   INCLUDES FIX DATED JUNE 25, 1985                       *
  9.  ************************************************************)
  10.  
  11. type
  12. line     = string[255];
  13.  
  14. var
  15. input    : line;
  16.  
  17. (****************************************************************************)
  18.  
  19. function exist (filename : line) : boolean;
  20.  
  21. var
  22. found    : boolean;
  23. testfile : file;
  24.  
  25. begin
  26.  
  27.     found := FALSE;
  28.     assign (testfile,filename);
  29.     {$I-} reset (testfile); {$I+}
  30.     found := (IOResult = 0);
  31.     if found then close (testfile);
  32.  
  33.     exist := found;
  34.  
  35. end; (* exist *)
  36.  
  37. (****************************************************************************)
  38.  
  39. function path_finder : line;
  40.  
  41. const
  42. pfad_prefix = 'PATH=';
  43.  
  44. var nullz,ende : boolean;
  45. c              : char;
  46. pfad_zaehler   : byte;
  47. pfad           : line;
  48. zahl1, zahl2   : integer;
  49.  
  50. begin
  51.  
  52.   nullz := FALSE;
  53.   ende  := FALSE;
  54.   zahl1 := memw[cseg:$2c];
  55.   zahl2 := 0;
  56.   pfad := '';
  57.  
  58.   repeat
  59.       c := chr(mem[zahl1:zahl2]);
  60.       if c <> #0 then
  61.       begin
  62.           pfad := pfad + c;
  63.           nullz := FALSE;
  64.       end
  65.       else
  66.           if (not nullz) then
  67.           begin
  68.               if pos(pfad_prefix,pfad) = 0 then pfad := ''
  69.                                            else ende := TRUE;
  70.               nullz := TRUE;
  71.           end
  72.           else ende := TRUE;
  73.       zahl2 := succ (zahl2);
  74.   until ende;
  75.   delete (pfad,1,5);
  76.  
  77.   path_finder := pfad;
  78.  
  79. end; (* path_finder *)
  80.  
  81. (****************************************************************************)
  82.  
  83. function suche_file (var s1: line) : boolean;
  84.  
  85. var
  86.  
  87. b1       : byte;
  88. s2,s3    : line;
  89. ok       : boolean;
  90.  
  91. begin
  92.  
  93.   ok   := FALSE;
  94.   b1   := 0;
  95.   s2   := '';
  96.  
  97.   if exist (s1) then
  98.       ok := TRUE
  99.   else
  100.   begin
  101.     s3   := path_finder;
  102.     b1   := pos (';',s3);
  103.     repeat
  104.         s2 := '';
  105.         if (b1>0) then
  106.         begin
  107.             s2 := copy (s3,1,b1-1);
  108.             delete (s3,1,b1);
  109.         end
  110.         else
  111.         begin
  112.             s2 := s3;
  113.             s3 := '';
  114.         end;
  115.         if (copy (s2,length(s2),1) <> '\') then s2 := s2 + '\';
  116.         b1 := 0;
  117.         b1 := pos (';',s3);
  118.         ok := exist (s2+s1);
  119.     until ok or (s3='');
  120.  
  121.     if ok then s1 := s2 + s1;
  122.   end;
  123.  
  124.     suche_file := ok;
  125.  
  126. end; (* suche_file *)
  127.  
  128. (********************** A little demonstration ... **************************)
  129.  
  130. begin
  131.  
  132.     ClrScr;
  133.     WriteLn ('Search for any file on PATH');
  134.     WriteLn ('Hit <RETURN> to end');
  135.     WriteLn;
  136.  
  137.     input := '';
  138.  
  139.     repeat
  140.  
  141.         write ('File to search for: ');
  142.         readln (input);
  143.  
  144.         if (input <> '') then
  145.             if suche_file (input)
  146.             then
  147.                 writeln ('Your file was found as "',input,'"')
  148.             else
  149.                 writeln ('The file "',input,'" cannot be found on PATH.');
  150.         WriteLn;
  151.  
  152.     until (input = '');
  153.  
  154. end.
  155.  
  156.