SUPERDIR.BAS

 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 'Super Directory for the IBM Personal Computer
110 'for monochrome or color adaptor,80 columns
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 'Remove the word REM from following line for automatic use with drive A
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 'Save descriptions to disk
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 'This subroutine reads disk directory into a string array
5010 'Enter with FSPEC$, the file spec for the FILES command
5020 'Exits with array F$, and NUMFILES, the number of files
5030 'uses a temporary array,TT$, which is ERASEd after use
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 'Put code for End, Enter into keyboard buffer:
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)
Outer Court
Echo Basic Postings

Books at Amazon:

Back to BASIC: The History, Corruption, and Future of the Language

Hackers: Heroes of the Computer Revolution (including Tiny BASIC)

Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution

The Advent of the Algorithm: The Idea that Rules the World

Moths in the Machine: The Power and Perils of Programming

Mastering Visual Basic .NET