home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l196 / 3.ddi / WHEREIS.BA$ / WHEREIS.bin
Encoding:
Text File  |  1990-06-24  |  4.6 KB  |  161 lines
  1. DEFINT A-Z
  2.  
  3. ' Declare symbolic constants used in program:
  4. CONST EOFTYPE = 0, FILETYPE = 1, DIRTYPE = 2, ROOT = "TWH"
  5.  
  6. DECLARE SUB ScanDir (PathSpec$, Level, FileSpec$, Row)
  7.  
  8. DECLARE FUNCTION MakeFileName$ (Num)
  9. DECLARE FUNCTION GetEntry$ (FileNum, EntryType)
  10. CLS
  11. INPUT "File to look for"; FileSpec$
  12. PRINT
  13. PRINT "Enter the directory where the search should start"
  14. PRINT "(optional drive + directories). Press <ENTER> to "
  15. PRINT "begin search in root directory of current drive."
  16. PRINT
  17. INPUT "Starting directory"; PathSpec$
  18. CLS
  19.  
  20. RightCh$ = RIGHT$(PathSpec$, 1)
  21.  
  22. IF PathSpec$ = "" OR RightCh$ = ":" OR RightCh$ <> "\" THEN
  23.     PathSpec$ = PathSpec$ + "\"
  24. END IF
  25.  
  26. FileSpec$ = UCASE$(FileSpec$)
  27. PathSpec$ = UCASE$(PathSpec$)
  28. Level = 1
  29. Row = 3
  30.  
  31. ' Make the top level call (level 1) to begin the search:
  32. ScanDir PathSpec$, Level, FileSpec$, Row
  33.  
  34. KILL ROOT + ".*"        ' Delete all temporary files created
  35.             ' by the program.
  36.  
  37. LOCATE Row + 1, 1: PRINT "Search complete."
  38. END
  39.  
  40. ' ======================= GETENTRY ========================
  41. '    This procedure processes entry lines in a DIR listing
  42. '    saved to a file.
  43. '    This procedure returns the following values:
  44. '  GetEntry$   A valid file or directory name
  45. '  EntryType   If equal to 1, then GetEntry$
  46. '        is a file.
  47. '        If equal to 2, then GetEntry$
  48. '        is a directory.
  49. ' =========================================================
  50. FUNCTION GetEntry$ (FileNum, EntryType) STATIC
  51.  
  52.     ' Loop until a valid entry or end-of-file (EOF) is read:
  53.     DO UNTIL EOF(FileNum)
  54.         LINE INPUT #FileNum, EntryLine$
  55.         IF EntryLine$ <> "" THEN
  56.  
  57.             ' Get first character from the line for test:
  58.      TestCh$ = LEFT$(EntryLine$, 1)
  59.      IF TestCh$ <> " " AND TestCh$ <> "." THEN EXIT DO
  60.         END IF
  61.     LOOP
  62.  
  63.     ' Entry or EOF found, decide which:
  64.     IF EOF(FileNum) THEN    ' EOF, so return EOFTYPE
  65.         EntryType = EOFTYPE  ' in EntryType.
  66.         GetEntry$ = ""
  67.  
  68.     ELSE                 ' Not EOF, so it must be a
  69.                     ' file or a directory.
  70.  
  71.         ' Build and return the entry name:
  72.         EntryName$ = RTRIM$(LEFT$(EntryLine$, 8))
  73.  
  74.         ' Test for extension and add to name if there is one:
  75.         EntryExt$ = RTRIM$(MID$(EntryLine$, 10, 3))
  76.         IF EntryExt$ <> "" THEN
  77.             GetEntry$ = EntryName$ + "." + EntryExt$
  78.         ELSE
  79.      GetEntry$ = EntryName$
  80.         END IF
  81.  
  82.         ' Determine the entry type, and return that value
  83.         ' to the point where GetEntry$ was called:
  84.         IF MID$(EntryLine$, 15, 3) = "DIR" THEN
  85.      EntryType = DIRTYPE            ' Directory
  86.         ELSE
  87.      EntryType = FILETYPE           ' File
  88.         END IF
  89.  
  90.     END IF
  91.  
  92. END FUNCTION
  93.  
  94. ' ===================== MAKEFILENAME$ =====================
  95. '    This procedure makes a file name from a root string
  96. '    ("TWH," defined as a symbolic constant at the module
  97. '    level) and a number passed to it as an argument (Num).
  98. ' =========================================================
  99. FUNCTION MakeFileName$ (Num) STATIC
  100.  
  101.     MakeFileName$ = ROOT + "." + LTRIM$(STR$(Num))
  102.  
  103. END FUNCTION
  104.  
  105. ' ======================= SCANDIR =========================
  106. '   This procedure recursively scans a directory for the
  107. '   file name entered by the user.
  108. '   NOTE: The SUB header doesn't use the STATIC keyword
  109. '         since this procedure needs a new set of variables
  110. '         each time it is invoked.
  111. ' =========================================================
  112. SUB ScanDir (PathSpec$, Level, FileSpec$, Row)
  113.  
  114.     LOCATE 1, 1: PRINT "Now searching"; SPACE$(50);
  115.     LOCATE 1, 15: PRINT PathSpec$;
  116.  
  117.     ' Make a file specification for the temporary file:
  118.     TempSpec$ = MakeFileName$(Level)
  119.  
  120.     ' Get a directory listing of the current directory,
  121.     ' and save it in the temporary file:
  122.     SHELL "DIR " + PathSpec$ + " > " + TempSpec$
  123.  
  124.     ' Get the next available file number:
  125.     FileNum = FREEFILE
  126.  
  127.     ' Open the DIR listing file and scan it:
  128.     OPEN TempSpec$ FOR INPUT AS #FileNum
  129. ' Process the file, one line at a time:
  130.     DO
  131.  
  132.         ' Input an entry from the DIR listing file:
  133.         DirEntry$ = GetEntry$(FileNum, EntryType)
  134.  
  135.         ' If entry is a file:
  136.         IF EntryType = FILETYPE THEN
  137.  
  138.      ' If the FileSpec$ string matches,
  139.      ' print entry and exit this loop:
  140.      IF DirEntry$ = FileSpec$ THEN
  141.          LOCATE Row, 1: PRINT PathSpec$; DirEntry$;
  142.          Row = Row + 1
  143.          EntryType = EOFTYPE
  144.      END IF
  145.  
  146.         ' If the entry is a directory, then make a recursive
  147.         ' call to ScanDir with the new directory:
  148.         ELSEIF EntryType = DIRTYPE THEN
  149.      NewPath$ = PathSpec$ + DirEntry$ + "\"
  150.      ScanDir NewPath$, Level + 1, FileSpec$, Row
  151.      LOCATE 1, 1: PRINT "Now searching"; SPACE$(50);
  152.      LOCATE 1, 15: PRINT PathSpec$;
  153.         END IF
  154.  
  155.     LOOP UNTIL EntryType = EOFTYPE
  156.  
  157.     ' Scan on this DIR listing file is finished, so close it:
  158.     CLOSE FileNum
  159. END SUB
  160.  
  161.