home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TBASIC / WHEREIS.INC < prev   
Text File  |  1987-04-01  |  22KB  |  545 lines
  1. '┌───────────────────────────────────────────────────────────────────────────┐
  2. '│                            WHEREIS.BAS                                    │
  3. '│                            VERSION 1.0                                    │
  4. '│                                                                           │
  5. '│                         MODULE: WHEREIS.INC                               │
  6. '│                                                                           │
  7. '│                   Turbo Basic                     │
  8. '│        (C) Copyright 1987 by Borland International             │
  9. '│                                                                           │
  10. '│ Procedures and Functions in this module:                                  │
  11. '│   The procedures and functions in this module are divided into three      │
  12. '│   groups:                                                                 │
  13. '│     1) Input Routines                                                     │
  14. '│     2) INLINE Assembler Routines                                          │
  15. '│     3) Directory Searching Routines                                       │
  16. '│                                                                           │
  17. '│ 1) INPUT ROUTINES:                                                        │
  18. '│   DEF FNIsDir%(FileSpec$)  ' returns whether or not the parameter is      │
  19. '│                            ' the name of a directory                 │
  20. '│   DEF FNIsLegalFileSpec%(FileSpec$)  ' returns if the file specification  │
  21. '│                                      ' given by the user is legal         │
  22. '│   SUB GetFileName(Path$, FileSpec$)  ' asks the user for the name of the  │
  23. '│                                      ' file to search for             │
  24. '│   DEF FNMassage$(Spec$)    ' manipulates a file name or specification     │
  25. '│                            ' so there are no spaces or *'s                │
  26. '│                                                                           │
  27. '│ 2) INLINE ASSEMBLER ROUTINES:                                             │
  28. '│   SUB SetDTA INLINE        ' sets the new address for the Data Transfer   │
  29. '│                            ' Area                         │
  30. '│   SUB GetDTA INLINE        ' gets the address of the current Data         │
  31. '│                            ' Transfer Area                     │
  32. '│   SUB GetDir INLINE        ' returns the current directory             │
  33. '│   SUB GetDrive INLINE      ' returns the current drive             │
  34. '│                                                                           │
  35. '│ 3) DIRECTORY SEARCHING ROUTINES                                           │
  36. '│   SUB GetStringAddr(Segment%, Offset%, S$) ' returns the address of the   │
  37. '│                                            ' string passed to it         │
  38. '│   DEF FNFindFirst%  ' finds the first file in a directory             │
  39. '│   DEF FNFindNext%   ' finds the next entry in a directory             │
  40. '│   DEF FNFoundMatch%(FSpec$, DTA$) ' returns whether or not the file spec. │
  41. '│                                   ' matches the last entry found in the   │
  42. '│                                   ' directory                 │
  43. '│   DEF FNStripWhiteSpace$(S$)      ' returns a string without any spaces   │
  44. '│                                   ' or null characters in it             │
  45. '│   SUB FindFiles(Path$, FileSpec$) ' this is the recursive procedure that  │
  46. '│                                   ' actually searches for the user's file │
  47. '│                                                                           │
  48. '└───────────────────────────────────────────────────────────────────────────┘
  49.  
  50.  
  51. '─────────────────────────── INPUT ROUTINES ──────────────────────────────────
  52.  
  53. DEF FNIsDir%(FileSpec$)
  54. ' This function returns whether or not FileSpec$ is the name of a
  55. ' directory. In order to do this we set up a local error handler to trap
  56. ' any run-time errors generated in this routine and then try to change
  57. ' directories to the directory specified by the user. If an error occurs
  58. ' we know that the directory doesn't exist. We trap the run-time error
  59. ' and return false in this case. Otherwise, we return true.
  60.  
  61.   LOCAL Drive%, OldDir$
  62.  
  63.   ' we need to strip the last "\" off the file spec so TB's CHDIR statement
  64.   ' won't give an I/O error.
  65.  
  66.   ' check if last char in file spec. is a "\" and if it's > 3
  67.   IF (RIGHT$(FileSpec$,1) = "\") AND (LEN(FileSpec$) > 3) THEN
  68.     FileSpec$ = LEFT$(FileSpec$,LEN(FileSpec$) - 1)    ' remove "\"
  69.   END IF
  70.  
  71.   OldDir$ = SPACE$(%DosPathLength)    ' allocate space for directory
  72.   CALL GetDrive(Drive%)            ' get the current path
  73.   CALL GetDir(0%, OldDir$)        ' get the current drive
  74.   OldDir$ = CHR$(Drive% + &H41) + ":\" + OldDir$        ' store drive\path
  75.  
  76.   ON ERROR GOTO DirErrorHandler        ' set up error trap
  77.   CHDIR FileSpec$            ' attempt to change directories
  78.  
  79.   FNIsDir% = %True ' if this is executed then the directory existed
  80.   CHDIR OldDir$    ' change back to original directory
  81.   GOTO ExitIsDir
  82.  
  83.   DirErrorHandler:
  84.     RESUME NotADir  ' clear error and continue execution
  85.  
  86.   NotADir:
  87.     FNIsDir% = %False  ' file spec. is not a directory name
  88.  
  89.   ExitIsDir:
  90.     ON ERROR GOTO 0
  91.  
  92. END DEF ' function FNIsDir%
  93.  
  94.  
  95. DEF FNIsLegalFileSpec%(FileSpec$)
  96. ' This function returns a value indicating if the file specification
  97. ' passed to it is legal. In order to determine this we compare each character
  98. ' in the file specification with a set of illegal characters. If there are
  99. ' any illegal characters in the file specification we return false. If there
  100. ' are no illegal characters we then check to make sure that there aren't
  101. ' more than eight characters in the file name and three characters in the
  102. ' extension.
  103.  
  104.   LOCAL Illegal$, DotPos%
  105.  
  106.   ' initialize illegal file characters
  107.   Illegal$ = "/\[]:|<>+=;," + CHR$(34)
  108.   FOR I% = 0 TO &H20
  109.     Illegal$ = Illegal$ + CHR$(I%)
  110.   NEXT I%
  111.  
  112.   FOR I% = 1 TO LEN(Illegal$)        ' for each character in file spec.
  113.     IF INSTR(FileSpec$, MID$(Illegal$, I%, 1)) <> 0 THEN
  114.       FNIsLegalFileSpec% = %False    ' assign function its result
  115.       EXIT DEF        ' no need to go further so exit function
  116.     END IF
  117.   NEXT I%
  118.  
  119.   FNIsLegalFileSpec% = %True        ' assign function its result
  120.  
  121.   DotPos% = INSTR(FileSpec$, ".")    ' get position of "." in file spec.
  122.   IF DotPos% = 0 THEN            ' no file extension
  123.     IF LEN(FileSpec$) > 8 THEN        ' file name is too long
  124.       FNIsLegalFileSpec% = %False    ' assign function its result
  125.     END IF
  126.   ELSEIF (DotPos% > 8) OR ((LEN(FileSpec$) - DotPos%) > 3) THEN
  127.     FNIsLegalFileSpec% = %False        ' file name is too long
  128.   END IF
  129.  
  130. END DEF ' function FNIsLegalFileSpec%
  131.  
  132.  
  133. SUB GetFileName(Path$, FileSpec$)
  134. ' This procedure returns the file to search for and where to begin looking.
  135. ' First it checks to see if the user specified the information on the DOS
  136. ' command line. If not it prompts the user for the information.
  137.  
  138.   LOCAL CurrentDrive%, Position%
  139.   LOCAL TempStr$, TempPath$, CurrentDir$, Drive%
  140.  
  141.   CurrentDrive% = 0
  142.   IF LEN(COMMAND$) > 0 THEN
  143.     TempStr$ = COMMAND$    ' get command line parameter
  144.   ELSE
  145.     INPUT "Please enter the path and file specification: ",TempStr$
  146.   END IF
  147.  
  148.   IF (LEN(TempStr$) >= 3) AND (MID$(TempStr$,2,1) = ":") AND _
  149.      (NOT (MID$(TempStr$,3,1) = "\")) THEN      ' start in current directory
  150.     ' user specified drive but not directory so assume the root directory
  151.     TempStr$ = LEFT$(TempStr$, 2) + "\" + RIGHT$(TempStr$, LEN(TempStr$) - 2)
  152.   END IF
  153.  
  154.   IF NOT FNIsDir%(TempStr$) THEN
  155.     DO                ' find last backslash in file spec.
  156.       Position% = INSTR(1, TempStr$, "\")
  157.       ' save first part of spec.
  158.       TempPath$ = TempPath$ + MID$(TempStr$, 1, Position%)
  159.       ' get what's left of string
  160.       TempStr$ = RIGHT$(TempStr$, LEN(TempStr$) - Position%)
  161.     LOOP UNTIL Position% = 0
  162.   ELSE
  163.     TempPath$ = TempStr$        ' user didn't give a file to search
  164.     TempStr$ = "*.*"            ' for so list them all
  165.   END IF
  166.  
  167.   IF TempPath$ = "" THEN TempPath$ = "\"        ' user didn't give path
  168.  
  169.   ' check if last char in file spec. is a "\" and if it's > 3
  170.   IF (RIGHT$(TempPath$,1) = "\") AND (LEN(TempPath$) > 3) THEN
  171.     TempPath$ = LEFT$(TempPath$,LEN(TempPath$) - 1)    ' remove last "\"
  172.   END IF
  173.  
  174.   Path$ = TempPath$    ' we now have the specified path and file spec.
  175.   FileSpec$ = TempStr$
  176.  
  177.   IF NOT FNIsDir%(Path$) THEN        ' verify that path exists
  178.     PRINT "You specified a non-existent drive\path...";
  179.     PRINT "Program aborting!"
  180.     CALL ByeBye                ' call abort routine
  181.   END IF
  182.  
  183.   IF NOT FNIsLegalFileSpec%(FileSpec$) THEN
  184.     PRINT "Invalid file specification"
  185.     PRINT "Program aborting!"
  186.     CALL ByeBye               ' call abort routine
  187.   END IF
  188.   LOCATE 2,1
  189.   PRINT USING "Searching for: &  Starting in directory: & ";FileSpec$, Path$
  190.   PRINT
  191. END SUB ' procedure GetFileName
  192.  
  193.  
  194. DEF FNMassage$(Spec$)
  195. ' This function expands a filename into it's maximum size inserting
  196. ' "?"s wherever appropriate. This makes it much easier to compare the
  197. ' file specification given by the user to the file names returned by
  198. ' the directory search routines.
  199.  
  200.   LOCAL StarPos%, DotPos%, TmpStr$    ' declare local variables
  201.  
  202.   StarPos% = INSTR(Spec$, "*")        ' get position of first '*' 
  203.   DotPos%  = INSTR(Spec$, ".")        ' get position of '.' 
  204.  
  205.   ' first fix up filename part of file specification
  206.   SELECT CASE StarPos%
  207.     CASE = 0            ' There is no '*' in the file name
  208.       IF DotPos% <> 0 THEN    ' there is a '.' indicating a file extension
  209.     TmpStr$ = LEFT$(Spec$, DotPos% - 1) + STRING$(9 - DotPos%, "?") + "."
  210.       ELSE            ' no "*" and no "." in the file spec
  211.     TmpStr$ = FNStripWhiteSpace$(Spec$)    ' strip any spaces or nulls
  212.     TmpStr$ = TmpStr$ + STRING$(8 - LEN(TmpStr$), "?") + "."
  213.       END IF
  214.     CASE = 1            ' "*" is first character in file name
  215.       TmpStr$ = "????????."
  216.     CASE > 1
  217.       IF StarPos% > DotPos% THEN    ' * is in extension not the file name
  218.     TmpStr$ = LEFT$(Spec$, DotPos% - 1) + STRING$(9 - DotPos%, "?") + "."
  219.       ELSE
  220.     TmpStr$ = LEFT$(Spec$, StarPos% - 1) + _
  221.           STRING$(9 - StarPos%, "?") + "."
  222.       END IF
  223.   END SELECT
  224.  
  225.   ' now fix up the file spec's extension
  226.  
  227.   IF DotPos% <> 0 THEN                ' "." exists in file name
  228.     StarPos% = INSTR(DotPos%, Spec$, "*") - DotPos%
  229.   ELSE
  230.     StarPos% = 0
  231.   END IF
  232.  
  233.   SELECT CASE StarPos%
  234.     CASE <= 0                ' there is no "*" in the extension
  235.       IF DotPos% <> 0 THEN
  236.     IF LEN(Spec$) > DotPos% THEN        ' there are chars after '.' 
  237.       Spec$ = FNStripWhiteSpace$(Spec$)
  238.       TmpStr$ = TmpStr$ + _
  239.             MID$(FNStripWhiteSpace$(Spec$), DotPos% + 1, _
  240.             LEN(Spec$) - DotPos%) + STRING$(3 - (LEN( _
  241.             FNStripWhiteSpace$(Spec$)) - DotPos%), "?")
  242.     ELSE                  ' "." is last char of file spec.
  243.       TmpStr$ = TmpStr$ + "???"
  244.     END IF
  245.       ELSE                  ' there isn't a "." in the file spec.
  246.     TmpStr$ = TmpStr$ + "???"
  247.       END IF
  248.     CASE = 1                ' star is first char of extension
  249.       TmpStr$ = TmpStr$ + "???"        ' so we ignore anything after it
  250.     CASE > 1                ' there are characters before "*"
  251.       TmpStr$ = TmpStr$ + _        ' so get them and expand *
  252.         MID$(Spec$, DotPos% + 1, StarPos% - (DotPos% + 1)) + _
  253.         STRING$(3 - (StarPos% - DotPos% + 2), "?")
  254.   END SELECT
  255.  
  256.   FNMassage$ = UCASE$(TmpStr$)
  257. END DEF ' function FNMassage$
  258.  
  259.  
  260. '───────────────────── INLINE ASSEMBLER ROUTINES ─────────────────────────────
  261.  
  262. SUB SetDTA INLINE ' (Segment%, Offset%, DTA$) - required parameter list
  263. ' This procedure sets the current Data Transfer Area. The procedure must be
  264. ' passed three parameters. The first two are the segment and the offset of
  265. ' the new DTA and the third is a string variable that will be used as the DTA.
  266. ' The reason all three parameters must be used is because the procedure can
  267. ' be called in either one of two ways. If both the Segment and Offset values
  268. ' are equal to zero then the DTA will be set to the location of the string
  269. ' descriptor. However, if either the segment or the offset is not equal to
  270. ' zero then then the DTA will be set to the address specified by the first
  271. ' two parameters.
  272.  
  273. $INLINE "SETDTA.BIN"        ' inline code file
  274.  
  275. END SUB ' procedure SetDTA
  276.  
  277.  
  278. SUB GetDTA INLINE ' (Segment%, Offset%) - required parameter list
  279. ' This procedure gets the address of the current Data Transfer Area. The
  280. ' procedure must be passed two parameters that will store the Segment and
  281. ' Offset of the current DTA.
  282.  
  283. $INLINE "GETDTA.BIN"        ' inline code file
  284.  
  285. END SUB
  286.  
  287.  
  288. SUB GetDir INLINE ' (Directory$) - required parameter list
  289. ' This procedure returns the current directory in the string parameter
  290. ' passed to it. Note that before calling this routine the string must have
  291. ' space allocated to it or this procedure will cause the string segment to
  292. ' be corrupted. The call should look like:
  293. ' 
  294. '   Directory$ = SPACE$(%DOSPathLength) ' allocate space for string
  295. '   CALL GetDir(Directory$)             ' get current directory
  296.  
  297. $INLINE "GETDIR.BIN"        ' inline code file
  298.  
  299. END SUB ' procedure GetDir
  300.  
  301.  
  302. SUB GetDrive INLINE ' (Drive%) - required parameter list
  303. ' This procedure returns a number representing the current drive in the
  304. ' integer parameter passed to it. A 0 represents drive A a 1 drive B, etc.
  305.  
  306. $INLINE "GETDRIVE.BIN"
  307.  
  308. END SUB ' procedure GetDrive
  309.  
  310.  
  311.  
  312. '────────────────────── DIRECTORY SEARCHING ROUTINES ─────────────────────────
  313.  
  314. SUB GetStringAddr(Segment%, Offset%, S$)
  315. ' This procedure returns the address of the string passed to it. In order to
  316. ' do this we must do two things; First we must get the segment of the string
  317. ' by doing a PEEK of the first two bytes of the Turbo Basic data segment.
  318. ' Then we must look at the string descriptor for the string to determine the
  319. ' offset of the string. The second step proves to be a bit more complex than
  320. ' the first.
  321.  
  322.   LOCAL Ofs%
  323.  
  324.   Segment% = PEEK(0) + (256 * PEEK(1)) ' get the location of the string segment
  325.  
  326.   DEF SEG = VARSEG(S$)    ' set default segment to location of string descriptor
  327.   Ofs% = VARPTR(S$)    ' get offset of string descriptor
  328.  
  329.   Offset% = PEEK(Ofs% + 2) + (256 * PEEK(Ofs% + 3))
  330.  
  331.   DEF SEG        ' restore Turbo Basic data segment
  332.  
  333. END SUB ' procedure GetStringAddr
  334.  
  335.  
  336. SUB ChangeDir(Directory$)
  337. ' This procedure changes the current directory to the one specified in the
  338. ' parameter. Note that if a drive specification is given, the routine also
  339. ' changes the current drive.
  340.  
  341.   LOCAL Segment%, Offset%, Drive%
  342.  
  343.   IF MID$(Directory$,2,1) = ":" THEN    ' need to change drives
  344.     REG %AX, &H0E00    ' DOS service to change drives
  345.     ' put destination drive in DL
  346.     REG %DX, (ASC(UCASE$(LEFT$(Directory$,1))) - &H41) AND &H00FF
  347.     CALL INTERRUPT &H21 ' make DOS service call
  348.   END IF
  349.  
  350.   CHDIR Directory$        ' change the current directory
  351.  
  352. END SUB 'ChangeDir
  353.  
  354.  
  355. DEF FNFindFirst%
  356. ' This function searches for the first file entry in a directory. It returns
  357. ' the error code that DOS returned in AX.
  358.  
  359.   SHARED FileMask$
  360.   LOCAL ErrorCode%, MaskOfs%, MaskSeg%
  361.  
  362.   CALL GetStringAddr(MaskSeg%, MaskOfs%, FileMask$) ' get address of mask
  363.  
  364.   REG %DS, MaskSeg%      ' segment of ASCIIZ string
  365.   REG %DX, MaskOfs%      ' offset of ASCIIZ string
  366.   REG %CX, &B00111111      ' specify attributes to search for (ALL)
  367.  
  368.   REG %AX, &H4E00
  369.   CALL INTERRUPT %DosCall    ' do DOS function call
  370.  
  371.   FNFindFirst% = REG(%AX)    ' return resulting code
  372.  
  373. END DEF ' function FNFindFirst%
  374.  
  375.  
  376. DEF FNFindNext%
  377. ' This function finds the next file entry in the current directory. It
  378. ' returns the error code that DOS returned in AX.
  379.  
  380.   SHARED FileMask$
  381.   LOCAL ErrorCode%, MaskOfs%, MaskSeg%
  382.  
  383.   CALL GetStringAddr(MaskSeg%, MaskOfs%, FileMask$)    ' get address of mask
  384.   REG %DS, MaskSeg%      ' segment of ASCIIZ string
  385.   REG %DX, MaskOfs%      ' offset of ASCIIZ string
  386.   REG %CX, &B00111111      ' specify attributes to search for (ALL)
  387.  
  388.   REG %AX, &H4F00
  389.   CALL INTERRUPT %DosCall    ' do DOS function call
  390.  
  391.   FNFindNext% = REG(%AX)    ' return DOS code
  392.  
  393. END DEF ' function FNFindNext%
  394.  
  395.  
  396. DEF FNFoundMatch%(FSpec$, DTA$)
  397. ' This function returns a boolean value indicating if the file found by
  398. ' the call to FNFindFirst% or FNFindNext% matches the users search
  399. ' specifications. It determines a match by copying the file entry found out
  400. ' of the DTA and comparing it with the user's file spec. Note that the
  401. ' file entries "." and ".." are never returned as matches since they are
  402. ' of little use to anyone looking for a file.
  403.  
  404.   LOCAL TmpStr$, TmpSpec$, TmpFile$, NameCount%, ExtCount%
  405.  
  406.   TmpStr$ = MID$(DTA$, %FileNameOfs, %FileNameLen)
  407.   IF LEFT$(TmpStr$,1) = "." OR LEFT$(TmpStr$,2) = ".." THEN   ' if "." or ".."
  408.     FNFoundMatch% = %False            ' directories then skip
  409.   ELSE    ' it's not "." or ".."
  410.     TmpSpec$ = FNMassage$(FSpec$)    ' massage file names
  411.     TmpFile$ = FNMassage$(TmpStr$)
  412.     FNFoundMatch% = %True        ' assume it's a match
  413.  
  414.     ' figure out last character to look at - either last non ? char or ...
  415.     FOR Count% = 1 TO 8        ' find last non-? in file name
  416.       IF MID$(TmpSpec$, Count%, 1) <> "?" THEN
  417.     NameCount% = Count%
  418.       END IF
  419.     NEXT Count%
  420.     IF NameCount% = 0 THEN NameCount% = 8      ' there weren't any non-? chars
  421.     FOR Count% = 10 TO 12    ' find last non-? in file extension
  422.       IF MID$(TmpSpec$, Count%, 1) <> "?" THEN
  423.     ExtCount% = Count%
  424.       END IF
  425.     NEXT Count%
  426.     IF ExtCount% = 0 THEN ExtCount% = 3  ' there weren't any non-? chars
  427.  
  428.     FOR Count% = 1 TO NameCount%
  429.       IF MID$(TmpSpec$, Count%, 1) <> MID$(TmpFile$, Count%, 1) THEN
  430.     IF MID$(TmpSpec$, Count%, 1) <> "?" THEN
  431.       FNFoundMatch% = %False    ' it's not a match so leave
  432.       EXIT DEF
  433.     END IF
  434.       END IF
  435.     NEXT Count%
  436.  
  437.     FOR Count% = 1 TO ExtCount%
  438.       IF MID$(TmpSpec$, Count%, 1) <> MID$(TmpFile$, Count%, 1) THEN
  439.     IF MID$(TmpSpec$, Count%, 1) <> "?" THEN
  440.       FNFoundMatch% = %False    ' it's not a match so leave
  441.       EXIT DEF
  442.     END IF
  443.       END IF
  444.     NEXT Count%
  445.   END IF
  446. END DEF ' function FNFoundMatch%
  447.  
  448.  
  449. DEF FNStripWhiteSpace$(S$)
  450. ' This function deletes any spaces or null characters from the string passed
  451. ' to it and returns the resulting string
  452.  
  453.   LOCAL SpacePos%, I%
  454.  
  455.   I% = 1        ' initialize counter
  456.   WHILE I% <= LEN(S$)    ' while we haven't reached the end of the string
  457.     IF (MID$(S$,I%,1) = CHR$(32)) OR (MID$(S$,I%,1) = CHR$(00)) THEN
  458.       S$ = LEFT$(S$, I% - 1) + RIGHT$(S$, LEN(S$) - I%) ' delete the character
  459.     ELSE
  460.       INCR I%    ' just increment the counter to the next char in the string
  461.     END IF
  462.   WEND
  463.   FNStripWhiteSpace$ = S$    ' return the new string
  464. END DEF ' FNStripWhiteSpace$
  465.  
  466.  
  467. SUB FindFiles(Path$, FileSpec$)
  468. ' This procedure is the main routine in the program. It is passed the files
  469. ' specification to search for and where to begin searching. It then does
  470. ' a recursive search - searching in any sub-directories of the directory
  471. ' specified by the user. When it has found the last entry in the directory
  472. ' specified by the user the program terminates.
  473.  
  474.  
  475.   SHARED FileMask$
  476.   LOCAL DTASegment%, DTAOffset%, ErrorCode%, Segg%, Ofss%
  477.   LOCAL InputStr$, DTA$
  478.  
  479.   DTA$ = SPACE$(%DTASize) ' allocate space for the Data Transfer Area
  480.               ' The DOS DTA looks like:
  481.               '  1..21 - reserved for DOS
  482.               '     22 - File Attribute
  483.               '          Note that the file attribute byte is set
  484.               '          up in the following manner:
  485.               '            BIT         Meaning
  486.               ' least sig-  1   - The file is marked READ ONLY
  487.               ' nificant    2   - Indicates a HIDDEN file
  488.               '             3   - Indicates a system file
  489.               '             4   - This entry is teh VOLUME LABEL
  490.               '             5   - Entry is a SUB-DIRECTORY
  491.               '             6   - Indicates an ARCHIVE bit
  492.               ' 23..24 - File's Time
  493.               ' 25..26 - File's Date
  494.               ' 27..28 - Low Word of File Size
  495.               ' 29..30 - High Word of File Size
  496.               ' 31..43 - File Name including period of file
  497.               '          extension exists and terminated bu NULL
  498.   PRINT "Searching: ";Path$
  499.  
  500.   CALL ChangeDir(Path$) ' change to directory to be searched
  501.  
  502.   DTASegment% = 0    ' set both offset and segment to 0 in order to
  503.   DTAOffset%  = 0    ' force the SetDTA routine to use the string variable
  504.   CALL SetDTA(DTASegment%, DTAOffset%, DTA$)    ' set the new DTA location
  505.  
  506.   MID$(DTA$, %FileNameOfs, %FileNameLen) = SPACE$(12) ' initialize DTA
  507.   ErrorCode% = FNFindFirst%
  508.   IF ErrorCode% = 0 THEN
  509.     IF FNFoundMatch%(FileSpec$, DTA$) THEN
  510.       PRINT USING "Found First Match: & ";Path$ + _
  511.                     MID$(DTA$,%FileNameOfs,%FileNameLen)
  512.     END IF
  513.     MID$(DTA$, %FileNameOfs, %FileNameLen) = SPACE$(12) ' initialize DTA
  514.     ErrorCode% = FNFindNext%
  515.     WHILE ErrorCode% = 0
  516.       IF INSTAT THEN
  517.     InputStr$ = INKEY$
  518.     IF LEFT$(InputStr$,1) = CHR$(27) THEN    ' if user pressed escape
  519.       CALL ByeBye
  520.     ELSE
  521.       WHILE NOT INSTAT : WEND        ' wait for user to press key
  522.       InputStr$ = INKEY$        ' gobble key stroke so it isn't
  523.     END IF                ' processed next time through loop
  524.     InputStr$ = ""
  525.       END IF
  526.       IF RIGHT$(Path$,1) = "\" THEN BackSpace$ = "" ELSE BackSpace$ = "\" 
  527.  
  528.       IF MID$(DTA$,22,1) = CHR$(%Directory) AND _
  529.         (NOT (MID$(DTA$,%FileNameOfs,1) = "." OR _
  530.               MID$(DTA$,%FileNameOfs,2) = "..")) THEN
  531.     CALL FindFiles(FNStripWhiteSpace(Path$ + BackSpace$ + _
  532.                MID$(DTA$,%FileNameOfs,%FileNameLen)), FileSpec$)
  533.     CALL SetDTA(DTASegment%, DTAOffset%, DTA$) ' set the new DTA location
  534.       ELSE
  535.     IF FNFoundMatch%(FileSpec$, DTA$) THEN
  536.       PRINT USING " & ";Path$ + BackSpace$ + _
  537.                 MID$(DTA$,%FileNameOfs,%FileNameLen)
  538.     END IF
  539.       END IF
  540.       MID$(DTA$, %FileNameOfs, %FileNameLen) = SPACE$(12) ' initialize DTA
  541.       ErrorCode% = FNFindNext%
  542.     WEND
  543.   END IF
  544. END SUB ' procedure FindFiles
  545.