home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / bmag / dirarray.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-15  |  4.0 KB  |  111 lines
  1. '─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
  2. '  Msg#: 442                                          Date: 13 Apr 94  20:50:26
  3. '  From: Marty Duplissey                              Read: Yes    Replied: No 
  4. '    To: Chris Gauvin                                 Mark:                     
  5. '  Subj: DIR
  6. '──────────────────────────────────────────────────────────────────────────────
  7. ' CG> I would like to know how to read files from a DIR < file.tst
  8. ' CG> into an array? Anybody?
  9. ' CG> Supressed Carrier
  10. 'Hear's a function I use in PDS. It won't work in QB but you can get some Ideas
  11. 'from it.
  12.  
  13.  
  14. FUNCTION dirarray% (Filespec$, Array$(), Flag%)
  15. '*****************************************************************
  16. '*Function  | Dirarray%                                          *
  17. '*Compiler  | PDS 7.1,VBDOS 1.0                                  *
  18. '*Requires  | Option Base 1,True,False,$Dynamic                  *
  19. '*Returns   | True if file found False if not Found              *
  20. '*Parameters| Filespec$: A valid filespec string to search on    *
  21. '*          |                                                    *
  22. '*          | Array$: A string array to hold the file names      *
  23. '*          | Redimed internaly so no concern for size if Dynamic*
  24. '*          | is enabled NOTE(Uses Redim Preserved Will not Work *
  25. '*          | with QB)                                           *
  26. '*          |                                                    *
  27. '*          | Flags%: An integer flag to tell if sorted or not   *
  28. '*          | 0 = Not sorted, 1 = Sorted by file name, 2 = Sorted*
  29. '*          | by extension. Uses bubble sort for now make note   *
  30. '*          | to rewrite to QUICKSORT in the future.             *
  31. '*          |                                                    *
  32. '*Notes     | REMEMBER this function sorts by string if using in *
  33. '*          | a numerical environment ie Netmail you must resort *
  34. '*          | accordingly.                                       *
  35. '*          | 03/04/94 Marty Duplissey                           *
  36. '*****************************************************************
  37.  
  38. REDIM Array$(100)
  39. Array$(1) = DIR$(Filespec$)
  40. Pointer% = 2
  41. '*********************************************************
  42. '*Build array
  43. IF LEN(Array$(1)) THEN
  44.   ok% = True
  45.   DO UNTIL ok% = False
  46.      Array$(Pointer%) = DIR$
  47.      IF LEN(Array$(Pointer%)) = 0 THEN EXIT DO
  48. '*********************************************************
  49. '*Make Array Bigger if needed
  50.      IF Pointer% = UBOUND(Array$, 1) THEN REDIM PRESERVE Array$(Pointer% + 100)
  51.      Pointer% = Pointer% + 1
  52.   LOOP
  53. REDIM PRESERVE Array$(Pointer% - 1)
  54. dirarray% = True
  55. ELSE
  56. dirray% = False
  57. END IF
  58.  
  59. SELECT CASE Flag%
  60. CASE 0
  61. '*********************************************************
  62. '*Do nothing take array as it is
  63. CASE 1
  64. '*********************************************************
  65. '*Sorted by Filename
  66. Size% = UBOUND(Array$, 1)
  67. Done% = False
  68. DO UNTIL Done% = True
  69.   Done% = True
  70.   FOR A% = Size% TO 2 STEP -1
  71.   IF Array$(A% - 1) > Array$(A%) THEN
  72.    SWAP Array$(A% - 1), Array$(A%)
  73.    Done% = False
  74.   ELSE
  75.   END IF
  76.   NEXT A%
  77. LOOP
  78.  
  79. CASE 2
  80. '*********************************************************
  81. '*Sort by extension
  82. Size% = UBOUND(Array$, 1)
  83. '*********************************************************
  84. '*Build index array to speed things up
  85. DIM ExtArray$(Size%)
  86. FOR A% = 1 TO Size%
  87.   Pointer% = INSTR(Array$(A%), ".")
  88.   IF Pointer% = 0 THEN Pointer% = LEN(Array$(A%))
  89.   Length% = LEN(Array$(A%))
  90.   ExtArray$(A%) = RIGHT$(Array$(A%), Length% - Pointer%)
  91. NEXT A%
  92. '*********************************************************
  93. 'Sort array and index array
  94. Done% = False
  95. DO UNTIL Done% = True
  96.   Done% = True
  97.   FOR A% = Size% TO 2 STEP -1
  98.   IF ExtArray$(A% - 1) > ExtArray$(A%) THEN
  99.    SWAP ExtArray$(A% - 1), ExtArray$(A%)
  100.    SWAP Array$(A% - 1), Array$(A%)
  101.    Done% = False
  102.   ELSE
  103.   END IF
  104.   NEXT A%
  105. LOOP
  106. CASE ELSE
  107. PRINT "Invalid flag passed to Function (Dirarray%). Program is stopped"
  108. END
  109. END SELECT
  110. END FUNCTION
  111.