10 'BACKLIST.bas    List names of files on Backup Disk
20 'SAVE"backlist.bas"
30 DIM PRT$(200) : KEY OFF
40 COLOR 7,1:CLS
50 '----- prompt for input -----
60 LOCATE 1,1:PRINT "BACKLIST (Ver 2.0) - Display Directories/Files on DOS 3.3 Backup Disks";
70 LOCATE 2,1:PRINT "         Jim Imbrogno - (216) 447-1600 Cleveland, Ohio";
80 LOCATE 5,15:PRINT "Enter Drive Letter: ";
90 DR$=INKEY$:IF DR$="" THEN GOTO 90
100 IF ASC(DR$) > 96 THEN DR$=CHR$(ASC(DR$)-32)  'convert to Upper Case
110 LOCATE 5,35:PRINT DR$;
120 LOCATE 7,15:PRINT "Press <F> to display File Names, or";
130 LOCATE 8,15:PRINT "Press <D> to display Directory Names ONLY";
140 TYPE$=INKEY$:IF TYPE$="" THEN GOTO 140
150 IF ASC(TYPE$) > 96 THEN TYPE$=CHR$(ASC(TYPE$)-32)  'convert to Upper Case
160 IF TYPE$ <> "D" AND TYPE$ <> "F" THEN SOUND 2500,.5 :GOTO 120
170 LOCATE 10,15:PRINT "Press <P> to send report to PRINTER";
180 LOCATE 11,15:PRINT "Press any other key to show report on SCREEN";
190 DEVICE$=INKEY$:IF DEVICE$="" THEN GOTO 190
200 IF ASC(DEVICE$) > 96 THEN DEVICE$=CHR$(ASC(DEVICE$)-32)  'convert to Upper Case
210 IF DEVICE$="P" THEN OPEN "LPT1:" FOR OUTPUT AS #2 ELSE OPEN "SCRN:" FOR OUTPUT AS #2
220 '----------------------------------------------------------------------
230 FILE$=DR$+":CONTROL.*"
240 ITEM%=0
250 ON ERROR GOTO 2130
260 CLS:LOCATE 1,1:FILES FILE$:NBR$=""
270 IF E%=53 GOTO 1860 'File not found
280 'IF E%=57 GOTO 890 'Device I/O error
290 FOR X%=10 TO 12
300 NBR$=NBR$+CHR$(SCREEN(2,X%))   'get backup disk number
310 NEXT X%
320 FILE$=DR$+":CONTROL."+NBR$     'complete file name
330 DISK%=VAL(NBR$)                'disk number
340 '----- display Header -----
350 CLS:COLOR 7,1
360 LOCATE 1,1:PRINT "BACKLIST (Ver 2.0) - Display Directories/Files on DOS 3.3 Backup Disks";
370 LOCATE 2,1:PRINT "         Jim Imbrogno - (216) 447-1600 Cleveland, Ohio";
380 LOCATE 3,5:PRINT "Drive: ";:LOCATE 3,12:COLOR 14,0:PRINT DR$;:COLOR 7,1:LOCATE 3,16:PRINT "Disk #: ";:COLOR 14,0:PRINT NBR$;:COLOR 7,1
390 IF DEVICE$ <> "P" THEN GOTO 440
400 PRINT #2,"__________________"
410 PRINT #2,"BACKLIST (Ver 2.0) - Display Directories/Files on DOS 3.3 Backup Disks"
420 PRINT #2,"Drive: ";DR$;"   Disk #: ";NBR$
430 LOCATE 7,15:COLOR 15,1:PRINT " Sending output to PRINTER ";:COLOR 7,1
440 LOCATE 5,1
450 '----- read data in CONTROL.nnn file -----
460 OPEN "R",#1,FILE$,1
470 IF E%=53 GOTO 1860 'File not found
480 FIELD 1,1 AS F$
490 BYTES=LOF(1)
500 R%=0
510 '
520 '----- process HEADER Record -----
530 RECD$=SPACE$(139)        'init record workspace
540 FOR X%=1 TO 139
550 R%=R%+1 : IF R% > BYTES THEN GOTO 1860  'EOJ
560 GET 1,R%                 'read next byte
570 MID$(RECD$,X%,1) = F$    'load workspace
580 NEXT X%
590 ITEM%=ITEM%+1
600 PRT$(ITEM%)=RECD$        'put workspace record in array
610 GOSUB 1790                'output results
620 '
630 '----- MAINLINE Loop - Process the rest of the CONTROL.nnn file -----
640 IF R%+1 > BYTES THEN GOTO 1860   'EOJ
650 GET 1,R%+1                      'read next byte
660 IF F$="F" THEN GOSUB 760 : GOTO 700 '(Directory Record)
670 IF F$=CHR$(34) AND TYPE$="F" THEN GOSUB 870 :GOTO 700  'chr$(34) = "  (File Rec)
680 IF F$=CHR$(34) AND TYPE$="D" THEN R%=R%+34:ITEM%=ITEM%+1:PRT$(ITEM%)=F$ :GOTO 700 'skip over File Rec
690 STOP:R%=R%+1 : GOTO 630   'if didn't detect Directory or File record, then increment byte & loop back
700 'sub-routine processed some data, now output the results
710 GOSUB 1790                'output results
720 GOTO 630   'loop back (R% was incremented in the sub-routines
730 '==========================================================================
740 '   SUB-ROUTINES
750 '==========================================================================
760 '===== Process DIRECTORY Record =====
770 RECD$=SPACE$(70)      'init work space
780 FOR X%=1 TO 70        'for each byte
790 R%=R%+1 : IF R% > BYTES THEN GOTO 1860
800 GET 1,R%              'read a byte
810 MID$(RECD$,X%,1) = F$ 'build record workspace
820 NEXT X%
830 '
840 ITEM%=ITEM%+1         'index for PRT$ array
850 PRT$(ITEM%)=RECD$     'put workspace into array
860 RETURN
870 '===== Process FILE Record =====
880 RECD$=SPACE$(34)
890 FOR X%=1 TO 34
900 R%=R%+1 : IF R% > BYTES THEN GOTO 1860
910 GET 1,R%
920 IF X% > 1 AND X% < 14 THEN IF F$=CHR$(0) THEN LSET F$=CHR$(32)   'replace null with space, only in FILE NAME part of file
930 MID$(RECD$,X%,1) = F$
940 NEXT X%
950 ITEM%=ITEM%+1
960 PRT$(ITEM%)=RECD$
970 S1$=MID$(PRT$(ITEM%),15,4)   'Size #1
980 S2$=MID$(PRT$(ITEM%),25,4)   'Size #2
990 T$=MID$(PRT$(ITEM%),31,2)   'Time
1000 D$=MID$(PRT$(ITEM%),33,2)   'Date
1010 B1 = ASC(MID$(T$,2,1))  :  B2 = ASC(MID$(T$,1,1))   'get values & flip bytes
1020 HH=0   'init
1030 HH= HH + ((B1 AND 128)/8)
1040 HH= HH + ((B1 AND 64)/8)
1050 HH= HH + ((B1 AND 32)/8)
1060 HH= HH + ((B1 AND 16)/8)
1070 HH= HH + ((B1 AND 8)/8)
1071 AP$="am":IF HH >= 12 THEN AP$="pm"  'AM or PM
1072 IF HH > 12 THEN HH=HH-12   'convert from 24hr clock
1073 IF HH < 10 THEN HH$=" "+MID$(STR$(HH),2,1) ELSE HH$=MID$(STR$(HH),2,2)
1080 MM=0   'init
1090 MM= MM + ((B1 AND 4)*8)
1100 MM= MM + ((B1 AND 2)*8)
1110 MM= MM + ((B1 AND 1)*8)
1120 MM= MM + ((B2 AND 128)/32)
1130 MM= MM + ((B2 AND 64)/32)
1140 MM= MM + ((B2 AND 32)/32)
1142 IF MM < 10 THEN MM$="0"+MID$(STR$(MM),2,1) ELSE MM$=MID$(STR$(MM),2,2)
1150 SS=0   'init
1160 SS= SS + (B2 AND 16)
1170 SS= SS + (B2 AND 8)
1180 SS= SS + (B2 AND 4)
1190 SS= SS + (B2 AND 2)
1200 SS= SS + (B2 AND 1)
1210 SS= SS * 2    'stored in 2-second increments
1212 IF SS < 10 THEN SS$=" "+MID$(STR$(SS),2,1) ELSE SS$=MID$(STR$(SS),2,2)
1215 HMS$=HH$+":"+MM$   '+":"+SS$  '(seconds not needed)
1220 B1 = ASC(MID$(D$,2,1))  :  B2 = ASC(MID$(D$,1,1))   'get values & flip bytes
1230 YR=1980   'init (to base year)
1240 YR= YR + ((B1 AND 128)/2)
1250 YR= YR + ((B1 AND 64)/2)
1260 YR= YR + ((B1 AND 32)/2)
1270 YR= YR + ((B1 AND 16)/2)
1280 YR= YR + ((B1 AND 8)/2)
1290 YR= YR + ((B1 AND 4)/2)
1300 YR= YR + ((B1 AND 2)/2)
1302 YR$=MID$(STR$(YR),4,2)
1310 MO=0   'init
1320 MO= MO + ((B1 AND 1)*8)
1330 MO= MO + ((B2 AND 128)/32)
1340 MO= MO + ((B2 AND 64)/32)
1350 MO= MO + ((B2 AND 32)/32)
1352 IF MO < 10 THEN MO$=" "+MID$(STR$(MO),2,1) ELSE MO$=MID$(STR$(MO),2,2)
1360 DA=0   'init
1370 DA= DA + (B2 AND 16)
1380 DA= DA + (B2 AND 8)
1390 DA= DA + (B2 AND 4)
1400 DA= DA + (B2 AND 2)
1410 DA= DA + (B2 AND 1)
1412 IF DA < 10 THEN DA$=" "+MID$(STR$(DA),2,1) ELSE DA$=MID$(STR$(DA),2,2)
1415 MDY$=MO$+"-"+DA$+"-"+YR$
1420 B1 = ASC(MID$(S1$,4,1))  :  B2 = ASC(MID$(S1$,3,1)) : B3 = ASC(MID$(S1$,2,1)) : B4 = ASC(MID$(S1$,1,1))  'get values & flip bytes
1430 SZ=0   'init
1440 SZ= SZ + ((B1 AND 128) * 2^24)
1450 SZ= SZ + ((B1 AND 64) * 2^24)
1460 SZ= SZ + ((B1 AND 32) * 2^24)
1470 SZ= SZ + ((B1 AND 16) * 2^24)
1480 SZ= SZ + ((B1 AND 8) * 2^24)
1490 SZ= SZ + ((B1 AND 4) * 2^24)
1500 SZ= SZ + ((B1 AND 2) * 2^24)
1510 SZ= SZ + ((B1 AND 1) * 2^24)
1520 SZ= SZ + ((B2 AND 128) * 2^16)
1530 SZ= SZ + ((B2 AND 64) * 2^16)
1540 SZ= SZ + ((B2 AND 32) * 2^16)
1550 SZ= SZ + ((B2 AND 16) * 2^16)
1560 SZ= SZ + ((B2 AND 8) * 2^16)
1570 SZ= SZ + ((B2 AND 4) * 2^16)
1580 SZ= SZ + ((B2 AND 2) * 2^16)
1590 SZ= SZ + ((B2 AND 1) * 2^16)
1600 SZ= SZ + ((B3 AND 128) * 2^8)
1610 SZ= SZ + ((B3 AND 64) * 2^8)
1620 SZ= SZ + ((B3 AND 32) * 2^8)
1630 SZ= SZ + ((B3 AND 16) * 2^8)
1640 SZ= SZ + ((B3 AND 8) * 2^8)
1650 SZ= SZ + ((B3 AND 4) * 2^8)
1660 SZ= SZ + ((B3 AND 2) * 2^8)
1670 SZ= SZ + ((B3 AND 1) * 2^8)
1680 SZ= SZ +  (B4 AND 128)
1690 SZ= SZ +  (B4 AND 64)
1700 SZ= SZ +  (B4 AND 32)
1710 SZ= SZ +  (B4 AND 16)
1720 SZ= SZ +  (B4 AND 8)
1730 SZ= SZ +  (B4 AND 4)
1740 SZ= SZ +  (B4 AND 2)
1750 SZ= SZ +  (B4 AND 1)
1760 'IF MID$(PRT$(ITEM%),2,9)="DUMMY.TXT" THEN STOP
1770 'PRINT "hex: ";HEX$(ASC(MID$(s1$,4,1)));" ";HEX$(ASC(MID$(s1$,3,1)));" ";hex$(asc(mid$(s1$,2,1)));" ";hex$(asc(mid$(s1$,1,1)))
1780 RETURN
1790 '----- Display/Print Results
1800 IF ITEM%=1 THEN COLOR 14,0:PRINT #2,"[Header] ";MID$(PRT$(ITEM%),2,6);:COLOR 7,1:PRINT: GOTO 1850
1810 IF MID$(PRT$(ITEM%),1,1)="F" THEN PRINT #2," ":COLOR 14,0:PRINT #2,"[Dir] ";:COLOR 12,0:PRINT #2,MID$(PRT$(ITEM%),2,63)
1820 'IF MID$(PRT$(ITEM%),1,1)="F" AND TYPE$="D" THEN COLOR 7,1:PRINT #2," "
1830 IF MID$(PRT$(ITEM%),1,1)=CHR$(34) AND TYPE$="F" THEN COLOR 7,1:PRINT #2,MID$(PRT$(ITEM%),2,12);"   ";SZ,MDY$,HMS$;AP$; "  (approximate time)
1840 IF MID$(PRT$(ITEM%),1,1)=CHR$(34) AND TYPE$="D" THEN PRINT #2,".";
1850 RETURN
1860 '----- EOJ - Prompt for more -----
1870 CLOSE 1
1880 COLOR 7,1:PRINT:PRINT
1890 SOUND 2500,.5
1900 LOCATE 24,15:PRINT "Process another disk? (Y/N)";
1910 LOCATE 24,43 : MORE$=INKEY$:IF MORE$="" THEN GOTO 1910
1920 IF ASC(MORE$) > 96 THEN MORE$=CHR$(ASC(MORE$)-32)  'convert to Upper Case
1930 IF MORE$ = "Y" THEN GOTO 230
1940 IF MORE$ <> "N" THEN GOTO 1890
1950 IF DEVICE$="P" THEN PRINT #2,CHR$(12);
1960 CLOSE 2
1970 END   '<======
1980 '===== get date & time ===================
1990 '===== (this test routine is never called)
2000 FOR X%= 0 TO 15
2010 PRINT X%;"=";2^X%
2020 NEXT X%
2030 F$=MKI$(5257)
2040 PRINT HEX$(ASC(MID$(F$,1,1)));" ";HEX$(ASC(MID$(F$,2,1)))
2050 T%=5257  :DIM PRT2$(16)
2060 FOR X%=1 TO 16
2070 PRT2$(X%)="0"
2080 'PRINT X%,2^(X%-1)
2090 IF (T% AND 2^(X%-1)) <> 0 THEN PRT2$(X%)="1"
2100 PRINT PRT2$(X%);" ";
2110 NEXT X%
2120 RETURN
2130 '===== trap for File error =====
2140 E% = ERR
2150 ERRCNT%=ERRCNT% + 1   'TO PREVENT RECURSIVE ERROR LOOPING
2160 IF ERRCNT% = 1 THEN GOTO 2180
2170 END   'EXCESSIVE ERRORS; ABORT
2180 'PRINT ERR:STOP   'DEBUG
2190 IF E%<>53 THEN GOTO 2250
2200 'ERROR 53; NO MATCH ON FILE SPEC
2210 LOCATE 10,15:PRINT "NO BACKUP FILES FOUND. PRESS ANY KEY TO CONTINUE";
2220 X$=INKEY$:IF X$="" THEN GOTO 2220
2230 ERRCNT%=0
2240 'BEEP:TRON:LOCATE 24,1
2250 'PRINT ERR:STOP
2260 RESUME NEXT