home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / basic / whereis.bas < prev    next >
Encoding:
BASIC Source File  |  1989-11-09  |  4.6 KB  |  164 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. ' ======================= GETENTRY ========================
  40. '    This procedure processes entry lines in a DIR listing
  41. '    saved to a file.
  42.  
  43. '    This procedure returns the following values:
  44. ' ===================== MAKEFILENAME$ =====================
  45. '    This procedure makes a file name from a root string
  46. '    ("TWH," defined as a symbolic constant at the module
  47. '    level) and a number passed to it as an argument (Num).
  48. ' =========================================================
  49.  
  50. ' ======================= SCANDIR =========================
  51. '   This procedure recursively scans a directory for the
  52. '   file name entered by the user.
  53.  
  54. '   NOTE: The SUB header doesn't use the STATIC keyword
  55. '         since this procedure needs a new set of variables
  56. '         each time it is invoked.
  57. ' =========================================================
  58.  
  59. '  GetEntry$   A valid file or directory name
  60. '  EntryType   If equal to 1, then GetEntry$
  61. '        is a file.
  62. '        If equal to 2, then GetEntry$
  63. '        is a directory.
  64. ' =========================================================
  65. FUNCTION GetEntry$ (FileNum, EntryType) STATIC
  66.  
  67.     ' Loop until a valid entry or end-of-file (EOF) is read:
  68.     DO UNTIL EOF(FileNum)
  69.         LINE INPUT #FileNum, EntryLine$
  70.         IF EntryLine$ <> "" THEN
  71.  
  72.             ' Get first character from the line for test:
  73.      TestCh$ = LEFT$(EntryLine$, 1)
  74.      IF TestCh$ <> " " AND TestCh$ <> "." THEN EXIT DO
  75.         END IF
  76.     LOOP
  77.  
  78.     ' Entry or EOF found, decide which:
  79.     IF EOF(FileNum) THEN    ' EOF, so return EOFTYPE
  80.         EntryType = EOFTYPE  ' in EntryType.
  81.         GetEntry$ = ""
  82.  
  83.     ELSE                 ' Not EOF, so it must be a
  84.                     ' file or a directory.
  85.  
  86.         ' Build and return the entry name:
  87.         EntryName$ = RTRIM$(LEFT$(EntryLine$, 8))
  88.  
  89.         ' Test for extension and add to name if there is one:
  90.         EntryExt$ = RTRIM$(MID$(EntryLine$, 10, 3))
  91.         IF EntryExt$ <> "" THEN
  92.             GetEntry$ = EntryName$ + "." + EntryExt$
  93.         ELSE
  94.      GetEntry$ = EntryName$
  95.         END IF
  96.  
  97.         ' Determine the entry type, and return that value
  98.         ' to the point where GetEntry$ was called:
  99.         IF MID$(EntryLine$, 15, 3) = "DIR" THEN
  100.      EntryType = DIRTYPE            ' Directory
  101.         ELSE
  102.      EntryType = FILETYPE           ' File
  103.         END IF
  104.  
  105.     END IF
  106.  
  107. END FUNCTION
  108.  
  109. FUNCTION MakeFileName$ (Num) STATIC
  110.  
  111.     MakeFileName$ = ROOT + "." + LTRIM$(STR$(Num))
  112.  
  113. END FUNCTION
  114.  
  115. SUB ScanDir (PathSpec$, Level, FileSpec$, Row)
  116.  
  117.     LOCATE 1, 1: PRINT "Now searching"; SPACE$(50);
  118.     LOCATE 1, 15: PRINT PathSpec$;
  119.  
  120.     ' Make a file specification for the temporary file:
  121.     TempSpec$ = MakeFileName$(Level)
  122.  
  123.     ' Get a directory listing of the current directory,
  124.     ' and save it in the temporary file:
  125.     SHELL "DIR " + PathSpec$ + " > " + TempSpec$
  126.  
  127.     ' Get the next available file number:
  128.     FileNum = FREEFILE
  129.  
  130.     ' Open the DIR listing file and scan it:
  131.     OPEN TempSpec$ FOR INPUT AS #FileNum
  132. ' Process the file, one line at a time:
  133.     DO
  134.  
  135.         ' Input an entry from the DIR listing file:
  136.         DirEntry$ = GetEntry$(FileNum, EntryType)
  137.  
  138.         ' If entry is a file:
  139.         IF EntryType = FILETYPE THEN
  140.  
  141.      ' If the FileSpec$ string matches,
  142.      ' print entry and exit this loop:
  143.      IF DirEntry$ = FileSpec$ THEN
  144.          LOCATE Row, 1: PRINT PathSpec$; DirEntry$;
  145.          Row = Row + 1
  146.          EntryType = EOFTYPE
  147.      END IF
  148.  
  149.         ' If the entry is a directory, then make a recursive
  150.         ' call to ScanDir with the new directory:
  151.         ELSEIF EntryType = DIRTYPE THEN
  152.      NewPath$ = PathSpec$ + DirEntry$ + "\"
  153.      ScanDir NewPath$, Level + 1, FileSpec$, Row
  154.      LOCATE 1, 1: PRINT "Now searching"; SPACE$(50);
  155.      LOCATE 1, 15: PRINT PathSpec$;
  156.         END IF
  157.  
  158.     LOOP UNTIL EntryType = EOFTYPE
  159.  
  160.     ' Scan on this DIR listing file is finished, so close it:
  161.     CLOSE FileNum
  162. END SUB
  163.  
  164.