home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / SUBDIR.ZIP / SUBDIR.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-09-26  |  8.6 KB  |  245 lines
  1. '   ┌─────────────────────────────────────────────────────────────────────┐
  2. '   │   This Quick Library is for Basic PDS 7                             │
  3. '   └─────────────────────────────────────────────────────────────────────┘
  4. '   ┌─────────────────────────────────────────────────────────────────────┐
  5. '   │                                                                     │
  6. '   │  These Routines are for MS dos Systems and do not use Interrupts.   │
  7. '   │                                                                     │
  8. '   │  If you like the Functions you can order the OBJ module an the      │
  9. '   │  Library LIB module for $7.00 .                                     │
  10. '   │                                                                     │
  11. '   │  To Register send $7.00 with your name and address to:              │
  12. '   │                                                                     │
  13. '   │                    ATTEN: SubDirectory program                      │
  14. '   │                    Scott Roepenack                                  │
  15. '   │                    3760 Secor road                                  │
  16. '   │                    South Venice, Fl. 34293                          │
  17. '   │                                                                     │
  18. '   │                                                                     │
  19. '   │  All comments welcome!                                              │
  20. '   │                                                                     │
  21. '   │                                                                     │
  22. '   │  Program info:                                                      │
  23. '   │                                                                     │
  24. '   │  Both Functions make a temp file in the current directory           │
  25. '   │  called DIR920A.TMP, file is killed after use...                    │
  26. '   │                                                                     │
  27. '   │                                                                     │
  28. '   │  SUBDIR1$ is for programs that will be run on dos 4.01 or earlyer   │
  29. '   │  It does not sort the directorys found.                             │
  30. '   │                                                                     │
  31. '   │  SUBDIR5$ is for programs on Dos 5.0 only                           │
  32. '   │  It sorts Directorys found and is much faster than SUBDIR1$ but     │
  33. '   │  it will only work on dos 5.0.                                      │
  34. '   │                                                                     │
  35. '   │  Do not use Direc$() Directly...                                    │
  36. '   │  It is Intialize every time its called, to null$ for STATIC and     │
  37. '   │  deallocates the array and frees memory for DYNAMIC programs.       │
  38. '   │                                                                     │
  39. '   │  You can use 'MaxCount' to get the Maximum number of Directorys     │
  40. '   │  found 'EndDirectory' returns 1 if not End of Directorys and -1     │
  41. '   │  if End of directory.                                               │
  42. '   │                                                                     │
  43. '   │  SUBDIR1$ and SUBDIR5$ returns a null$ or 0 len if there is no      │
  44. '   │  directorys Otherwise return > 0 len or a string 'OK', you can      │
  45. '   │  check for ether.                                                   │
  46. '   │                                                                     │
  47. '   │  NOTE: You must first Load QB or QBX with Quick Library             │
  48. '   │                                                                     │
  49. '   │  For QuickBasic:   QB /L QBSUBDIR.QLB                               │
  50. '   │                                                                     │
  51. '   │        For PDS7:   QBX /L B7SUBDIR.QLB                              │
  52. '   │                                                                     │
  53. '   │                                                                     │
  54. '   │                                                                     │
  55. '   │  If you have or intend to use on DOS 5.0 then change the 1 to 5 in  │
  56. '   │  SUBDIR1$. ( using 5 sorts directorys )                             │
  57. '   └─────────────────────────────────────────────────────────────────────┘
  58.  
  59.  
  60.  
  61. 'Start Of Program
  62. '-----------------------------------------------------------------------------
  63.  
  64. '$DYNAMIC  'let make the program dynamic
  65. '$INCLUDE: 'subdir.bi' ' must include this in your programs
  66.  
  67.   ON ERROR GOTO ErrHandler  ' error routine to make sure everythings OK
  68.   CLS : SCREEN 0
  69.  
  70.   Fmat$ = "Directory Number:### ==> &"
  71.   c$ = STRING$(80, 196)
  72.  
  73.   PRINT "Using the DO LOOP..."
  74.   PRINT c$
  75.  
  76.     'Call SUBDIR1$ with a root Path first
  77.     ' you can call any SubDirectory, Example: C:\QB45
  78.   junk$ = SUBDIR1$("c:\")
  79.     
  80.     ' If theres directorys, show them on the screen until all are read,
  81.     ' Else there where no directorys were found.
  82.   IF LEN(junk$) > 1 THEN
  83.     'Call SUBDIR1$ again but pass a null$
  84.     DO: c = c + 1: PRINT USING Fmat$; c; SUBDIR1$(""): LOOP UNTIL EndDirectory
  85.   ELSE
  86.     'Else None where found
  87.     BEEP: PRINT "No Directorys Found..."
  88.     END
  89.   END IF
  90.  
  91.   'Or ...
  92.  
  93.   SLEEP (1)
  94.   PRINT : PRINT "Using the FOR NEXT LOOP..."
  95.   PRINT c$;
  96.  
  97.   junk$ = SUBDIR1$("c:\")  'Call SUBDIR1$ with a path first
  98.  
  99.     ' Read it into x$ (or an array) and print Directorys found
  100.   IF junk$ = "OK" THEN
  101.     FOR j = 1 TO MaxCount
  102.         'Call SUBDIR1$ again but pass a null$
  103.       x$ = SUBDIR1$("")
  104.       PRINT USING "Directory Number:### ==> &"; j; x$
  105.     NEXT j
  106.   ELSE
  107.     'Else None where found
  108.     BEEP: PRINT "No Directorys Found..."
  109.     END
  110.   END IF
  111.  
  112.   'or
  113.  
  114.   SLEEP (1): CLS
  115.  
  116.     'if your using PDS use the function CURDIR$
  117.   DO: INPUT "Are you using (Q)uick Basic or Basic (P)DS7 "; Responce$
  118.   LOOP UNTIL UCASE$(Responce$) = "Q" OR UCASE$(Responce$) = "P"
  119.  
  120.   IF UCASE$(Responce$) = "P" THEN BC7% = 1 ELSE BC7% = 0
  121.  
  122.   CLS : LOCATE 3, 12
  123.   PRINT "(** Example use for changing directorys with SUBDIR1$ **)";
  124.  
  125.   LOCATE 5, 1
  126.   PRINT " Use the UP or DOWN arrows to select the directory,  Hit Enter key to shell...";
  127.  
  128.   LOCATE 6, 1: PRINT c$;
  129.   LOCATE 8, 1: PRINT c$;
  130.  
  131.   LOCATE 1, 62: PRINT "Hit 'Esc' to Quit"
  132.  
  133.  
  134.     'Call SUBDIR1$ with a path first
  135.   junk$ = SUBDIR1$("c:\")
  136.  
  137.     'dim the x$ array after your first call with MaxCount
  138.   IF junk$ = "OK" THEN
  139.     DIM x$(1 TO MaxCount)
  140.   ELSE
  141.     BEEP: PRINT "No Directorys Found..."
  142.     END
  143.   END IF
  144.  
  145.   'if OK, Read it into an array and show Directorys found
  146.   FOR j = 1 TO MaxCount
  147.       'Call SUBDIR1$ again but pass a null$
  148.     x$(j) = SUBDIR1$("")
  149.   NEXT j
  150.  
  151.     'show one of the directorys of the array
  152.   LOCATE 7, 2
  153.   PRINT x$(1);
  154.  
  155.     'Put Array number at the begining
  156.   ArrayNum% = 1
  157.  
  158. DO
  159.  
  160.   DO: key$ = INKEY$: LOOP WHILE key$ = ""
  161.  
  162.     key$ = RIGHT$(key$, 1)
  163.  
  164.   SELECT CASE key$
  165.     CASE CHR$(27)'escape
  166.  
  167.       ' Quit and exit do
  168.       EXIT DO
  169.  
  170.     CASE CHR$(72)'up
  171.  
  172.       IF ArrayNum% > 1 THEN
  173.         ArrayNum% = ArrayNum% - 1 'make the array go up
  174.       ELSE
  175.         SOUND 167, .5
  176.       END IF
  177.  
  178.     CASE CHR$(80)'down
  179.  
  180.       IF ArrayNum% < MaxCount - 2 THEN
  181.         ArrayNum% = ArrayNum% + 1 'make the array go down
  182.       ELSE
  183.         SOUND 167, .5
  184.       END IF
  185.  
  186.     CASE CHR$(13)'enter
  187.  
  188.       IF BC7% THEN
  189.         cd$ = CURDIR$
  190.       ELSE
  191.       END IF
  192.      
  193.       SHELL "CD " + x$(ArrayNum%) 'change dir
  194.  
  195.       PCOPY 0, 1: CLS : PRINT : PRINT
  196.       PRINT "Type 'EXIT' to return to demo SUBDIR..."
  197.       SHELL: PCOPY 1, 0
  198.  
  199.       IF BC7% THEN
  200.         SHELL "CD " + cd$ 'change back to the original directory
  201.         cd$ = ""
  202.       ELSE
  203.       END IF
  204.  
  205.  
  206.     CASE ELSE
  207.   END SELECT
  208.  
  209.     'make sure the array is not bigger than the screen
  210.   IF LEN(x$(ArrayNum%)) > 79 THEN
  211.     LET x$(ArrayNum%) = LEFT$(x$(ArrayNum%), 76) + "..."
  212.   END IF
  213.  
  214.   LOCATE 7, 2: PRINT SPACE$(79); ' clear the old
  215.   LOCATE 7, 2: PRINT x$(ArrayNum%); ' show the new array
  216.  
  217. LOOP
  218.  
  219.   PRINT
  220.   LOCATE 11, 22: PRINT "If you liked this, Please Register!"
  221.   LOCATE 13, 22: PRINT "Just Send $7.00 to:"
  222.   LOCATE 15, 26: PRINT "ATTEN: SubDirectory program"
  223.   LOCATE 16, 26: PRINT "Scott Roepenack"
  224.   LOCATE 17, 26: PRINT "3760 Secor Road"
  225.   LOCATE 18, 26: PRINT "South Venice, FL. 34293"
  226.   LOCATE 20, 22: PRINT "With your name and address printed"
  227.   BEEP
  228.   END
  229.  
  230. '---------------------------------------------------------------------------
  231.  
  232. ErrHandler:
  233.  
  234. SELECT CASE ERR
  235.     CASE 57  'Device I/O error.
  236.         END
  237.     CASE 68  'Device unavailable.
  238.         END
  239.     CASE 71  'Drive not ready.
  240.         END
  241.     CASE ELSE
  242.         STOP
  243. END SELECT
  244.  
  245.