BBS: Inland Empire Archive
Date: 02-25-93 (22:30) Number: 379
From: CASEY PEARSON Refer#: NONE
To: ALL Recvd: NO
Subj: SUPERDIR.BAS Conf: (2) Quik_Bas
Someone asked if there was a Directory program in BASIC, well here is
one that was developed a while back, but still works wonders!
WARNING: this is a program that was released by IBM for demonstration
purpose and is shown here for the same reason, to use it for
profit or other means, you BETTER contact IBM first!!!
100
110
120 SCREEN 0,0,0:WIDTH 80:COLOR 0,4,8:CLS:DEFINT A-Z:KEY OFF:FOR I=1 TO 10:KEY
130 CR$=CHR$(17)+CHR$(196)+CHR$(217)
140 PRINT "Welcome to ";:COLOR 15:PRINT "Super Directory":COLOR 0
150
160 REM DRIVE$="A:":FSPEC$="A:*.*":GOTO 200
170 PRINT:PRINT "Select Drive: (";:COLOR 16,15:PRINT"A
B";:COLOR 7,0:PRINT CHR$
180 DRIVE$=INKEY$+":":A=ASC(DRIVE$):IF (A OR 32)<97 OR (A OR 32)>98 THEN 180
190 DRIVE$=CHR$(A AND 223)+":":FSPEC$=DRIVE$+"*.*"
200 GOSUB 5000:CLS:COLOR 16:PRINT"Reading description file"
210 DIM D$(ENTRIES):FOR I=0 TO ENTRIES:D$(I)=CHR$(9)+"--" :NEXT
220 ON ERROR GOTO 310
230 OPEN DRIVE$+"DESCR.DIR" FOR INPUT AS #1
240 LINE INPUT #1,DISKNAME$:LINE INPUT#1,A$:NUMREC=VAL(A$)
250 FOR ITEMS=0 TO NUMREC
260 LINE INPUT #1,F$:LINE INPUT#1,D$
270 FOR I=0 TO ENTRIES
280 IF F$=F$(I) THEN D$(I)=D$
290 NEXT:NEXT
300 GOTO 320
310 RESUME 320
320 CLOSE#1:ON ERROR GOTO 0
330 PAGES=INT(ENTRIES/10)
340 CURR=0
350 START=CURR*10:FINISH=START+9:IF FINISH>ENTRIES THEN FINISH=ENTRIES
360 CLS:COLOR 0,4,8:PRINT STRING$(80,32):LOCATE
1,2:PRINT"Super Directory";TAB(
370 FOR I=START TO FINISH
380 COLOR 0,15:PRINT "F";LEFT$(MID$(STR$(1+I-START),2)+"
",2);:COLOR 15,4:PRINT
390 NEXT
400 LOCATE 25,1:COLOR 15,4:PRINT"Press ";:COLOR
0,15:PRINT"F1";:COLOR 15,4:PRIN
410 LOCATE 23,32:PRINT"Page #";CURR+1;"of ";PAGES+1
420 A$=INKEY$:IF A$="" THEN 420
430 IF A$<>CHR$(27) THEN 540
440 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT" 1.Exit to BASIC 2. Exit
450 A$=INKEY$:IF A$<"1" OR A$>"5" THEN 450
460 ON VAL(A$) GOTO 470,480,490,500:GOTO 350
470 COLOR 0:CLS:END
480 SYSTEM
490 RUN
500 ON ERROR GOTO 510:GOSUB 1000:GOTO 350
510 BEEP:LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:COLOR
31:PRINT"Can't save de
520 IF INKEY$<>CHR$(13) THEN 520
530 RESUME 350
540 IF A$=CHR$(0)+CHR$(81) THEN CURR=-(CURR+1)*(CURR<PAGES):GOTO 350
550 IF A$=CHR$(0)+CHR$(73) THEN CURR=CURR-1:CURR=CURR-
(PAGES+1)*(CURR<0):GOTO 3
560 A=ASC(MID$(A$+"0",2))-59:IF A<0 OR A>FINISH-START THEN BEEP:GOTO 420
570 LOCATE 25,1:PRINT SPACE$(79);:LOCATE 25,1:PRINT"Press
";CR$;" to run progra
580 LOCATE 3+A*2,5:COLOR 31:PRINT F$(START+A);:COLOR 15
590 A$=INKEY$:IF A$<>CHR$(13) AND A$<>CHR$(27) AND A$<>CHR$(32) THEN 590
600 IF A$=CHR$(27) THEN LOCATE 3+A*2,5:PRINT F$(START+A);:GOTO 400
610 IF A$<>CHR$(32) THEN 670
620 IF DISKNAME$="" THEN LOCATE 25,1:PRINT
SPACE$(79);:LOCATE 25,1:LINE INPUT;"
630 LOCATE 25,1:PRINT SPACE$(79);:LOCATE
25,1:Z=START+A:PRINT "Description :";D
640 LOCATE 25,1:PRINT SPACE$(79);:BEEP:COLOR 31:LOCATE
25,1:PRINT"Cannot save d
650 A$=INKEY$:IF A$<>"y" AND A$<>"Y" AND A$<>"n" AND A$<>"N" THEN 650
660 IF A$="y" OR A$="Y" THEN RESUME 680 ELSE RESUME 350
670 ON ERROR GOTO 640:GOSUB 1000
680 ON ERROR GOTO 690:COLOR 0:CLS:RUN DRIVE$+F$(START+A)
690 LOCATE 25,1:PRINT SPACE$(79):COLOR 16:BEEP:PRINT"Cannot
run ";F$(A);". ";:
700 IF INKEY$<>CHR$(13) THEN 700
710 RESUME 350
720 END
1000
1010 OPEN DRIVE$+"DESCR.DIR" FOR OUTPUT AS #1
1020 PRINT#1,DISKNAME$;CHR$(13);ENTRIES;CHR$(13);
1030 FOR I=0 TO ENTRIES:PRINT#1,F$(I);CHR$(13);D$(I);CHR$(13);:NEXT
1040 CLOSE #1:ON ERROR GOTO 0:RETURN
1050
5000
5010
5020
5030
5040
5050 DEF SEG=0:WIDTH 80
5060 HEAD=1050:TAIL=1052:BUFFER=1054
5070 CLS:COLOR 16,4,4:PRINT"Reading disk directory"
5080 COLOR 4:ON ERROR GOTO 5100
5090 FILES FSPEC$:ON ERROR GOTO 0:GOTO 5110
5100 BEEP:COLOR 31:CLS:PRINT"Cannot read directory":COLOR
4:ON ERROR GOTO 0:END
5110 DIM TT$(24):LOCATE 3,1:COLOR 4:ROWS=0
5120
5130 POKE HEAD,30:POKE TAIL,34:POKE BUFFER,0:POKE
BUFFER+1,79:POKE BUFFER+2,13:
5140 LINE INPUT TT$(ROWS)
5150 IF TT$(ROWS)<>"" THEN ROWS=ROWS+1:GOTO 5130
5160 IF NOT DIMMED THEN DIM F$(ROWS*4-1):DIMMED=1
5170 ROWS=ROWS-1
5180 FOR I=0 TO ROWS
5190 FOR J=0 TO 3
5200 T$=MID$(TT$(I),J*18+1,12)
5210 IF T$<>"" THEN F$(ENTRIES)=T$:ENTRIES=ENTRIES+1
5220 NEXT J
5230 NEXT I
5240 ERASE TT$:ENTRIES=ENTRIES-1
5250 DEF SEG:RETURN
... þ SLMR 2.1a þ Nothing is so smiple that it can't get screwed up.
--- DCQwk/T.A.G. 1.5a
* Origin: The Abacus * HST/DS * Potterville MI (1:159/100)
