home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / BASIC00.ZIP / DISKLIB.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  7.8 KB  |  203 lines
  1. 10 REM ************ DISK LIBRARIAN ***************
  2. 20 REM **** VERSION 1.1  REDONE BY AL STOUT ******
  3. 30 REM ************** 12-19-82 *******************
  4. 31 REM ****ENHANCEMENTS BY AUGUST BUGGE **********
  5. 32 REM **************  1-16-83 *******************
  6. 35 ON ERROR GOTO 5000
  7. 40 KEY OFF: CLS
  8. 41 COLOR 15,0
  9. 42 PRINT CHR$(201)+STRING$(77,205)+CHR$(187)
  10. 50 PRINT CHR$(186)+STRING$(77,32)+CHR$(186)
  11. 55 FOR I=1 TO 15:PRINT CHR$(186);SPACE$(77);CHR$(186):NEXT
  12. 60 PRINT CHR$(186)+STRING$(77,32)+CHR$(186)
  13. 70 PRINT CHR$(200)+STRING$(77,205)+CHR$(188)
  14. 75 LOCATE 2,15:PRINT "            DISKETTE LIBRARIAN "
  15. 80 LOCATE 4,5:PRINT "THIS PROGRAM WILL READ THE DIRECTORIES OF DISKETTES AS THEY ARE FEED    "
  16. 85 LOCATE  5,5:PRINT "ONE AT A TIME THROUGH DRIVE A:.  THE ENTIRE LIBRARY MAY THEN BE PRINTED"
  17. 87 LOCATE  6,5:PRINT "AS SORTED BY FILE OR DISKETTE.  IF THE DISKETTE HAS A FILE WITH        "
  18. 88 LOCATE 7, 5:PRINT "EXTENSION .NAM , THEN THIS IS ASSUMED TO BE THE DISKETTE NAME.         "
  19. 89 LOCATE  9,5:PRINT "1) PLACE A SPARE DISKETTE NOT TO BE CATALOGED IN DRIVE B:."
  20. 90 LOCATE 10,5:PRINT "2) INSERT DISKETTES TO BE CATALOGED IN DRIVE A: ONE AT A TIME.  YOU   "
  21. 91 LOCATE 11,5:PRINT "   MAY REMOVE ONE DISK AND INSERT ANOTHER AS SOON AS THE RED LIGHT IN  "
  22. 92 LOCATE 12,5:PRINT "   DRIVE A: GOES OUT."
  23. 93 LOCATE 13,5:PRINT "3) WHEN REQUESTED, TYPE DISK NAME (MAX 8 CHAR) OR JUST HIT RETURN IF "
  24. 94 LOCATE 14,5:PRINT "   DISKETTE CONTAINS FILE WITH A .NAM EXTENSION.  TYPE <END> TO STOP"
  25. 95 LOCATE 15,5:PRINT "   READING DIRECTORIES AND BEGIN OUTPUT OF FILE/DISKETTE CROSS         "
  26. 96 LOCATE 16,5:PRINT "   REFERENCE LISTING."
  27. 97 LOCATE 17,5:PRINT "4) ENTER UP TO 800 SEPARATE FILES."
  28. 125 COLOR 7
  29. 130 PRINT
  30. 140 COLOR 18:LOCATE 20,1:PRINT "INSERT WORK DISK IN DRIVE B: IF NOT ALREADY DONE":COLOR 7
  31. 150 PRINT
  32. 160 PRINT
  33. 170 PRINT "HIT ANY KEY WHEN READY";
  34. 180 SEQ$=INKEY$ : IF SEQ$ = "" THEN 180
  35. 190 SE=0
  36. 200 XXX$ = "FILE" :YYY$ = "DISK"
  37. 220 DEFINT I,J,K,L,N
  38. 230 DIM ARRA$(64)
  39. 240 SKP = 0 'SWITCH TO PRINT ALIGN PAPER ONLY ONCE
  40. 250 P=1     'PAGE NUMBER
  41. 260 OPEN "B:DATA" FOR OUTPUT AS #1
  42. 265 CLS
  43. 270 PRINT "ENTER NAME OF DISK IN DRIVE A, OR <ENTER> (IF .NAM) OR END"
  44. 280 PRINT " <-------->"
  45. 290 LOCATE 15,1 : PRINT "TOTAL FILES READ = ";N1: LOCATE 4,1
  46. 300 INPUT;DNAM$
  47. 310 CLS
  48. 320 IF DNAM$="END" OR DNAM$="end" THEN GOTO 720 ELSE 440
  49. 325 GOTO 440
  50. 330 CLS:PRINT "DO YOU WANT TO LIST IN ";YYY$;" SEQUENCE, (Y) OR (N) ?";
  51. 340 CH$=INKEY$ : IF CH$="" THEN 340
  52. 350 IF CH$="Y" OR CH$="y" THEN 370
  53. 360 SYSTEM
  54. 370 ERASE ARRAY$ :FC = FCP
  55. 380 ERASE S.SP%: CLOSE #1: P = 1
  56. 390 ERASE AR$,FL$,DSK$ : SKP = 1 : SKIP = 0
  57. 400 SWAP XXX$, YYY$
  58. 410 IF SE=0 THEN SE=1 ELSE SE=0
  59. 430 GOTO 740
  60. 440 CLS
  61. 450 FILES "A:*.*"
  62. 460 DEF SEG = &HB000
  63. 470 N=1
  64. 480 FOR I=0 TO 1600 STEP 160
  65. 490 FOR J=0 TO 130 STEP 26
  66. 500 FILEBILD$ = ""
  67. 510 L = I+J
  68. 520 FOR K=0 TO 24 STEP 2
  69. 530 FILEBILD$ = FILEBILD$ + CHR$(PEEK(K+L))
  70. 540 NEXT K
  71. 550 IF LEFT$(FILEBILD$,1) = " " THEN 610
  72. 560 ARRA$(N) = FILEBILD$
  73. 570 N = N+1
  74. 580 FILEBILD$ = ""
  75. 590 NEXT J
  76. 600 NEXT I
  77. 610 N=N-1
  78. 620 N1=N1+N
  79. 625 GOSUB 1800
  80. 630 GOSUB 650
  81. 640 GOTO 265
  82. 650 REM write array to file
  83. 660 FOR I = 1 TO N
  84. 670 PRINT #1,USING "\                   \";ARRA$(I)+DNAM$
  85. 680 ARRA$(I)=""
  86. 690 NEXT I
  87. 700 FC=FC+N
  88. 710 RETURN
  89. 720 CLOSE #1
  90. 730 FCP=FC
  91. 740 REM This example sorts "ARRAY$" in ascending order
  92. 750 DIM ARRAY$(FCP)
  93. 760 OPEN "B:DATA " FOR INPUT AS #1
  94. 770 FOR I = 1 TO FCP
  95. 780 IF SE = 1 THEN 810
  96. 790 INPUT#1,ARRAY$(I)
  97. 800 IF SE = 0 THEN 830
  98. 810 INPUT#1,REV$
  99. 820 ARRAY$(I) = MID$(REV$,14,8)+MID$(REV$,1,13)
  100. 830 NEXT I
  101. 840 GOSUB 900 ' Call to sort subroutine
  102. 850 PRINT "SORT COMPLETE                    " TIME$
  103. 860 GOTO 1060
  104. 870 REM *******************************************
  105. 880 REM ********* QUICKER SORT SUBROUTINE *********
  106. 890 REM *********                         *********
  107. 900 S.AL% = FCP ' Limit of array to be sorted **** REQUIRED FOR SORT ****
  108. 910 CLS:PRINT "SORT STARTED ...STAND BY         " TIME$
  109. 920 DIM S.SP%(CINT(LOG(S.AL%)/.346574),2) 'If sort is to be called more than once, `DIM' the stack `S.SP%' for the largest size of the array outside the sort
  110. 930 S.IS% = 0: S.LL% = 1: S.UL% = S.AL%: GOTO 990
  111. 940 SWAP ARRAY$(S.SL%),ARRAY$(S.LL%):IF S.SL% > S.UL%-2 THEN S.UL% = S.SL%-1 ELSE IF S.SL% < S.LL%+2 THEN S.LL% = S.LL%+1 ELSE S.IS% = S.IS%+1: S.SP%(S.IS%,1)=S.LL%: S.SP%(S.IS%,2) = S.SL%-1: S.LL%=S.SL%+1
  112. 950 GOTO 990
  113. 960 FOR S.I1% = S.LL% + 1 TO S.UL%: FOR S.I2% = S.LL% TO S.I1%: IF ARRAY$(S.I1%) < ARRAY$(S.I2%) THEN SWAP ARRAY$(S.I1%),ARRAY$(S.I2%)
  114. 970 NEXT S.I2%: NEXT S.I1%
  115. 980 IF S.IS% = 0 THEN RETURN ELSE S.LL% = S.SP%(S.IS%,1): S.UL%=S.SP%(S.IS%,2): S.IS% = S.IS%-1
  116. 990 IF S.UL% - S.LL% <= 9 THEN 960 ELSE S.LS% = S.LL%: S.US% = S.UL% + 1: SWAP ARRAY$(S.LL%),ARRAY$(INT((S.US%-S.LS%)/2)+S.LL%)
  117. 1000 IF S.US% = S.LS%+1 THEN S.SL% = S.LS%: GOTO 940 ELSE S.LS% = S.LS% + 1: IF ARRAY$(S.LS%) <= ARRAY$(S.LL%) THEN 1020
  118. 1010 IF S.US% = S.LS% + 1 THEN S.SL% = S.LS%-1: GOTO 940 ELSE S.US% = S.US% - 1: IF ARRAY$(S.US%) >= ARRAY$(S.LL%) THEN 1010 ELSE SWAP ARRAY$(S.LS%),ARRAY$(S.US%): GOTO 1000
  119. 1020 IF S.US% = S.LS% + 1 THEN S.SL% = S.LS%: GOTO 940 ELSE S.US% = S.US% - 1: IF ARRAY$(S.US%) >= ARRAY$(S.LL%) THEN 1000
  120. 1030 IF S.US% = S.LS% + 1 THEN S.SL% = S.US%: GOTO 940 ELSE S.LS% = S.LS% + 1: IF ARRAY$(S.LS%) <= ARRAY$(S.LL%) THEN 1030 ELSE SWAP ARRAY$(S.LS%),ARRAY$(S.US%): GOTO 1020
  121. 1040 END '******** End of quicker sort subroutine **
  122. 1050 REM *******************************************
  123. 1060 REM WRITE CATALOG FILE AND PRINT
  124. 1070 DIM AR$(100),FL$(100),DSK$(100)
  125. 1080 IF FCP> 100 THEN 1170
  126. 1090 FCX = FCP
  127. 1100 FOR Y = 1 TO FC
  128. 1110 AR$(Y) = ARRAY$(Y)
  129. 1120 ARRAY$(Y) = " "
  130. 1130 NEXT Y
  131. 1140 GOSUB 1360
  132. 1150 LPRINT CHR$(12) : SKIP = 0
  133. 1160 GOTO 330
  134. 1170 X = 0
  135. 1180 FOR Y= 1 TO 100
  136. 1190 AR$(Y) = ARRAY$(Y+X)
  137. 1200 ARRAY$(Y+X) = " "
  138. 1210 NEXT Y
  139. 1220 X = X + 100
  140. 1230 FCX = 100
  141. 1240 GOSUB 1360
  142. 1250 LPRINT CHR$(12) : SKIP = 0
  143. 1260 FC = FC - 100
  144. 1265 ERASE AR$,FL$,DSK$
  145. 1266 DIM AR$(100),FL$(100),DSK$(100)
  146. 1270 IF FC > 100 THEN 1180
  147. 1280 FOR Y= 1 TO FC
  148. 1290 AR$(Y) = ARRAY$(Y+X)
  149. 1300 ARRAY$(Y+X) = " "
  150. 1310 NEXT Y
  151. 1320 FCX = FC
  152. 1330 GOSUB 1360
  153. 1340 LPRINT CHR$(12) : SKIP = 0
  154. 1350 GOTO 330
  155. 1360 FOR I = 1 TO FCX
  156. 1370 IF SE = 1 GOTO 1400
  157. 1380 FL$(I)=MID$(AR$(I),1,12): DSK$(I)=MID$(AR$(I),14,8)
  158. 1390 GOTO 1410
  159. 1400 DSK$(I)=MID$(AR$(I),1,8): FL$(I)=MID$(AR$(I),9,12)
  160. 1410 NEXT I
  161. 1420 IF SKP = 1 THEN 1470
  162. 1430 CLS:LOCATE 15,15
  163. 1440 PRINT "ALIGN PAPER FOR OUTPUT, PRESS ANY KEY TO PRINT"
  164. 1450 SKP = 1
  165. 1460 Z$ = INKEY$: IF Z$ = "" THEN 1460
  166. 1470 K=FCX/2
  167. 1480 FOR I=0 TO K-1
  168. 1490 FOR J=1 TO FCX STEP K
  169. 1500 IF SKIP = 1 GOTO 1600
  170. 1510 LPRINT CHR$(14); STRING$(6,32)+"DISK LIBRARY"+STRING$(4,32)+DATE$
  171. 1520 LPRINT CHR$(20)
  172. 1530 LPRINT TAB(25) "SEQUENCED BY ";XXX$ TAB(56) "PAGE ";P
  173. 1540 LPRINT
  174. 1550 LPRINT TAB(7) XXX$ TAB(23) YYY$ TAB(41) XXX$ TAB(57) YYY$
  175. 1560 LPRINT STRING$(66,163)
  176. 1570 LPRINT CHR$(27);"F"
  177. 1580 P=P+1
  178. 1590 SKIP = 1
  179. 1600 IF SE = 1 THEN 1630
  180. 1610 LPRINT USING "  \             \";FL$(I+J);DSK$(I+J);
  181. 1620 GOTO 1660
  182. 1630 IF DSK$(I+J) = DSK$((I+J)-1) THEN DK$ = " " ELSE DK$ = DSK$(I+J)
  183. 1640 LPRINT USING "  \             \";DK$;FL$(I+J);
  184. 1650 DK$ = ""
  185. 1660 NEXT J
  186. 1670 LPRINT
  187. 1680 NEXT I
  188. 1690 RETURN
  189. 1800 ' SUBROUTINE TO DETERMINE DISKETTE NAME
  190. 1810 FOR I= 1 TO N
  191. 1820 IF MID$(ARRA$(I),10,3)<> "NAM" THEN GOTO 1860
  192. 1840 DNAM$=LEFT$(ARRA$(I),8)
  193. 1850 RETURN
  194. 1860 NEXT I
  195. 1870 CLS: PRINT"FILE WITH EXTENSION .NAM NOT FOUND"
  196. 1880 PRINT "ENTER NAME OF DISK IN DRIVE A:"
  197. 1890 INPUT; DNAM$
  198. 1900 RETURN
  199. 5000 'ERROR TRAPPING
  200. 5010 IF ERR=53 THEN CLS: PRINT "NO FILES ON THIS DISK. INSERT ANOTHER.":RESUME 270
  201. 5020 IF ERL=450 THEN PRINT "FILE READ ERROR.  ERR = ";ERR;".  TRY AGAIN.":RESUME 270
  202. 5030 CLS: PRINT"SORRY, UNRECOVERABLE ERROR.  ERR = ";ERR;" ON LINE ";ERL:END
  203.  ERROR.  ERR = ";ERR;".  TRY AGAIN.":RES