home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CMPLTPAS.ZIP / SEARCHER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-25  |  8.6 KB  |  224 lines
  1. {--------------------------------------------------------------}
  2. {                          Searcher                            }
  3. {                                                              }
  4. {             General-purpose file search unit                 }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/25/88              }
  9. {                                                              }
  10. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  11. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  12. {--------------------------------------------------------------}
  13.  
  14. {$F+}
  15. UNIT Searcher;
  16.  
  17. INTERFACE
  18.  
  19. USES DOS;
  20.  
  21.  
  22. { Note that this unit REQUIRES version 5.0 to compile! }
  23.  
  24. TYPE
  25.   HitProc = PROCEDURE(Foundit : SearchRec; InDirectory : String);
  26.  
  27. PROCEDURE SearchAll(Directory: String;
  28.                     Spec : String;
  29.                     Attribute : Byte;
  30.                     DoIt : HitProc);
  31.  
  32. PROCEDURE SearchOne(Directory : String;
  33.                     Spec      : String;
  34.                     Attribute : Byte;
  35.                     Doit      : Hitproc);
  36.  
  37. PROCEDURE SearchCurrent(Spec : String; Attribute : Byte; Doit : Hitproc);
  38.  
  39.  
  40. IMPLEMENTATION
  41.  
  42.  
  43. {->>>>SearchAll<<<<--------------------------------------------}
  44. {                                                              }
  45. { UNIT FILE: SEARCHER.PAS  --  Last Modified 6/29/88           }
  46. {                                                              }
  47. { This is a search "engine" that traverses the entire DOS      }
  48. { directory tree of the current disk volume, looking for files }
  49. { that match a filespec passed in Spec, and an attribute byte  }
  50. { passed in Attribute.  Whenever a matching file is found, the }
  51. { found file's DTA is passed to a procedural parameter, which  }
  52. { then takes some action using the information in the DTA.     }
  53. {                                                              }
  54. { The underlying logic of using FIND FIRST and FIND NEXT is    }
  55. { almost identical to that of the LOCATE.PAS program, with the }
  56. { the difference that LOCATE.PAS only displays information on  }
  57. { the found files.  Passing different procedures in HitProc    }
  58. { allows SearchAll to perform any action on a found file that  }
  59. { you care to code up as a procedural parameter.               }
  60. {--------------------------------------------------------------}
  61.  
  62. PROCEDURE SearchAll(Directory: String;
  63.                     Spec : String;
  64.                     Attribute : Byte;
  65.                     DoIt : HitProc);
  66.  
  67. VAR
  68.   CurrentDTA : SearchRec;
  69.   TempDirectory,NextDirectory : String;
  70.  
  71.  
  72. BEGIN
  73.   { First we look for any subdirectories.  If any are found, }
  74.   { we make a recursive call and search 'em too: }
  75.  
  76.   { Suppress unnecessary backslashes if we're searching the root: }
  77.   IF Directory = '\' THEN
  78.     TempDirectory := Directory + '*.*'
  79.   ELSE
  80.     TempDirectory := Directory + '\*.*';
  81.  
  82.   { Now make the FIND FIRST call for directories: }
  83.  
  84.   FindFirst(TempDirectory,$10,CurrentDTA);
  85.  
  86.  
  87.   { Here's the tricky stuff.  If we get an indication that there is }
  88.   { at least one more subdirectory within the current directory,    }
  89.   { (indicated by lack of error codes 2 or 18) we must search it    }
  90.   { by making a recursive call to SearchDirectory.  We continue     }
  91.   { recursing and returning from the searched subdirectories until  }
  92.   { we get a code indicating none are left. }
  93.   WHILE (DOSError <> 2) AND (DOSError <> 18) DO
  94.     BEGIN
  95.       IF  ((CurrentDTA.Attr AND $10) = $10)   { If it's a directory }
  96.       AND (CurrentDTA.Name[1] <> '.') THEN  { and not '.' or '..' }
  97.         BEGIN
  98.           { Add a slash separating sections of the path if we're not }
  99.           { currently searching the root: }
  100.           IF Directory <> '\' THEN NextDirectory := Directory + '\'
  101.             ELSE NextDirectory := Directory;
  102.  
  103.           { This begins with the current directory name, and copies }
  104.           { the name of the found directory from the current DTA to }
  105.           { the end of the current directory string.  Then the new  }
  106.           { path is passed to the next recursive instantiation of   }
  107.           { SearchDirectory. }
  108.           NextDirectory := NextDirectory + CurrentDTA.Name;
  109.  
  110.           { Here's where we call "ourselves." }
  111.           SearchAll(NextDirectory,Spec,Attribute,DoIt);
  112.  
  113.         END;
  114.        FindNext(CurrentDTA);  { Now we look for more... }
  115.     END;
  116.  
  117.   { Now we can search for files, once we've run out of directories.  }
  118.   { This is conceptually simpler, as recursion is not involved.      }
  119.   { We combine the path and the file spec into one string, and make  }
  120.   { the FIND FIRST call: }
  121.  
  122.   { Suppress unnecessary slashes for root search: }
  123.   IF Directory <> '\' THEN
  124.     TempDirectory := Directory + '\' + Spec
  125.   ELSE TempDirectory := Directory + Spec;
  126.  
  127.   { Now, make the FIND FIRST call: }
  128.   FindFirst(TempDirectory,Attribute,CurrentDTA);
  129.  
  130.   IF DOSError = 3 THEN       { Bad path error }
  131.     Writeln('Path not found; check spelling.')
  132.  
  133.   { If we found something in the current directory matching the filespec, }
  134.   { call the procedural parameter to take some action on the found DTA:   }
  135.   ELSE IF (DOSError = 2) OR (DOSError = 18) THEN
  136.     { Null; Directory is empty }
  137.   ELSE
  138.     BEGIN
  139.       DoIt(CurrentDTA,Directory);         { Call the procedural parameter }
  140.       IF DOSError <> 18 THEN              { More files are out there...   }
  141.         REPEAT
  142.           FindNext(CurrentDTA);           { Look for additional matches   }
  143.           IF DOSError <> 18 THEN          { More entries exist }
  144.           DoIt(CurrentDTA,Directory)      { Call the procedural parameter }
  145.         UNTIL (DOSError = 18) OR (DOSError = 2)  { Ain't no more! }
  146.     END
  147. END;
  148.  
  149.  
  150.  
  151. {->>>>SearchOne<<<<--------------------------------------------}
  152. {                                                              }
  153. { UNIT FILE: SEARCHER.PAS  --  Last Modified 5/28/88           }
  154. {                                                              }
  155. { This procedure is a subset of SearchAll, in that it only     }
  156. { searches the directory specified in Directory, and not the   }
  157. { entire directory tree of the current disk volume.  In all    }
  158. { other respects it operates the same way.                     }
  159. {--------------------------------------------------------------}
  160.  
  161.  
  162. PROCEDURE SearchOne(Directory : String;
  163.                     Spec      : String;
  164.                     Attribute : Byte;
  165.                     Doit      : Hitproc);
  166.  
  167. VAR
  168.   TempDirectory : String;
  169.   CurrentDTA : SearchRec;
  170.  
  171. BEGIN
  172.   { Suppress unnecessary slashes for root search: }
  173.   IF Directory <> '\' THEN
  174.     TempDirectory := Directory + '\' + Spec
  175.   ELSE TempDirectory := Directory + Spec;
  176.  
  177.   { Now, make the FIND FIRST call: }
  178.   FindFirst(TempDirectory,Attribute,CurrentDTA);
  179.  
  180.   IF DOSError = 3 THEN       { Bad path error }
  181.     Writeln('Path not found; check spelling.')
  182.  
  183.   { If we found something in the current directory matching the filespec, }
  184.   { call the procedural parameter to take some action on the found DTA:   }
  185.   ELSE IF (DOSError = 2) OR (DOSError = 18) THEN
  186.     { Null; Directory is empty }
  187.   ELSE
  188.     IF DOSError <> 18 THEN                { More files are out there...   }
  189.       BEGIN
  190.         DoIt(CurrentDTA,Directory);       { Call the procedural parameter }
  191.         REPEAT
  192.           FindNext(CurrentDTA);           { Look for additional matches   }
  193.           IF DOSError <> 18 THEN          { More entries exist }
  194.             DoIt(CurrentDTA,Directory);   { Call the procedural parameter }
  195.         UNTIL (DOSError = 18) OR (DOSError = 2)          { Ain't no more! }
  196.       END
  197. END;
  198.  
  199.  
  200.  
  201. {->>>>SearchCurrent<<<<----------------------------------------}
  202. {                                                              }
  203. { UNIT FILE: SEARCHER.PAS  --  Last Modified 5/28/88           }
  204. {                                                              }
  205. { This procedure uses the same FIND FIRST/FIND NEXT logic of   }
  206. { SearchAll and SearchOne, but only searches the current       }
  207. { directory.  It therefore does not need to be passed a        }
  208. { parameter specifying the directory to be searched.           }
  209. {--------------------------------------------------------------}
  210.  
  211.  
  212. PROCEDURE SearchCurrent(Spec : String; Attribute : Byte; Doit : Hitproc);
  213.  
  214. VAR
  215.   Directory : String;
  216.  
  217. BEGIN
  218.   GetDir(0,Directory);  { Query DOS for the name of the current directory }
  219.   SearchOne(Directory,Spec,Attribute,DoIt);
  220. END;
  221.  
  222.  
  223. END.
  224.