home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / FILEFIND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-01  |  3.2 KB  |  152 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.  ************************************************************)
  9.  
  10. type
  11. line     = string[255];
  12.  
  13. var
  14. input    : line;
  15.  
  16. (****************************************************************************)
  17.  
  18. function exist (filename : line) : boolean;
  19.  
  20. var
  21. found    : boolean;
  22. testfile : file;
  23.  
  24. begin
  25.  
  26.     found := FALSE;
  27.     assign (testfile,filename);
  28.     {$I-} reset (testfile); {$I+}
  29.     found := (IOResult = 0);
  30.     if found then close (testfile);
  31.  
  32.     exist := found;
  33.  
  34. end; (* exist *)
  35.  
  36. (****************************************************************************)
  37.  
  38. function path_finder : line;
  39.  
  40. const
  41. pfad_prefix = 'PATH=';
  42.  
  43. var nullz,ende : boolean;
  44. c              : char;
  45. pfad_zaehler   : byte;
  46. pfad           : line;
  47. zahl1, zahl2   : integer;
  48.  
  49. begin
  50.  
  51.   nullz := FALSE;
  52.   ende  := FALSE;
  53.   zahl1 := memw[cseg:$2c];
  54.   zahl2 := 0;
  55.   pfad := '';
  56.  
  57.   repeat
  58.       c := chr(mem[zahl1:zahl2]);
  59.       if c <> #0 then
  60.       begin
  61.           pfad := pfad + c;
  62.           nullz := FALSE;
  63.       end
  64.       else
  65.           if (not nullz) then
  66.           begin
  67.               if pos(pfad_prefix,pfad) = 0 then pfad := ''
  68.                                            else ende := TRUE;
  69.               nullz := TRUE;
  70.           end
  71.           else ende := TRUE;
  72.       zahl2 := succ (zahl2);
  73.   until ende;
  74.   delete (pfad,1,5);
  75.  
  76.   path_finder := pfad;
  77.  
  78. end; (* path_finder *)
  79.  
  80. (****************************************************************************)
  81.  
  82. function suche_file (var s1: line) : boolean;
  83.  
  84. var
  85.  
  86. b1       : byte;
  87. s2,s3    : line;
  88. ok       : boolean;
  89.  
  90. begin
  91.  
  92.   ok   := FALSE;
  93.   b1   := 0;
  94.   s2   := '';
  95.  
  96.   if exist (s1) then
  97.       ok := TRUE
  98.   else
  99.   begin
  100.     s3   := path_finder;
  101.     b1   := pos (';',s3);
  102.     repeat
  103.         s2 := '';
  104.         if (b1>0) then
  105.         begin
  106.             s2 := copy (s3,1,b1-1);
  107.             delete (s3,1,b1);
  108.         end
  109.         else
  110.         begin
  111.             s2 := s3;
  112.             s3 := '';
  113.         end;
  114.         if (copy (s2,length(s2),1) <> '\') then s2 := s2 + '\';
  115.         b1 := 0;
  116.         b1 := pos (';',s3);
  117.         ok := exist (s2+s1);
  118.     until ok or (s3='');
  119.  
  120.     if ok then s1 := s2 + s1;
  121.   end;
  122.  
  123. end; (* suche_file *)
  124.  
  125. (********************** A little demonstration ... **************************)
  126.  
  127. begin
  128.  
  129.     ClrScr;
  130.     WriteLn ('Search for any file on PATH');
  131.     WriteLn ('Hit <RETURN> to end');
  132.     WriteLn;
  133.  
  134.     input := '';
  135.  
  136.     repeat
  137.  
  138.         write ('File to search for: ');
  139.         readln (input);
  140.  
  141.         if (input <> '') then
  142.             if suche_file (input)
  143.             then
  144.                 writeln ('Your file was found as "',input,'"')
  145.             else
  146.                 writeln ('The file "',input,'" cannot be found on PATH.');
  147.         WriteLn;
  148.  
  149.     until (input = '');
  150.  
  151. end.
  152.