10 'Display File Allocation Table and Directory
20 CLS 'Requires Advanced Basic with 512 byte file buffer: BASICA /S:512
30 ON ERROR GOTO 60 :COM(1) OFF :ON ERROR GOTO 0
40 CLEAR ,16384! ' by J.L. Aker - San Jose CA
50 IF VARPTR(#2)-VARPTR(#1) > 699 THEN 90
60 PRINT"Hold it!  You didn't call Basica with /s: 512"
70 PRINT"Reload: Basica /s:512"
80 SYSTEM
90 DEFINT B,D,F,I,T,S,K,N,R
100  C$=STRING$(28,"1") 'dummy string for code
110 DIM SS(318),NA$(112) : CR$=CHR$(13)
120 INPUT"Drive, A or B";SG$
130 IF SG$="b" OR SG$="B" THEN DRV=1
140 INPUT"Screen or Printer, S or P";SG$
150 IF SG$="p" OR SG$="P" THEN DEV$="LPT1:" ELSE DEV$="SCRN:" : GOTO 180
160 INPUT"Condensed print, Y or N";SG$
170 IF SG$="n" OR SG$="N" THEN SG$="2"+CHR$(18) ELSE SG$="0"+CHR$(15)
180 INPUT"Skip Deleted Directory slots, Y or N";DS$
190 OPEN DEV$ FOR OUTPUT AS 1
200 IF DEV$="LPT1:" THEN LPRINT CHR$(27);SG$;
210 DATA 16,BA,00,00,B9,04,00,B8
220 DATA 79,0E,8B,D8,B8,01,02,CD
230 DATA 13,B7,00,8A,DC,9A,07,00
240 DATA 00,F6,17,CB
250 OFS=VARPTR(C$) 'string descriptor
260 OFC=PEEK(OFS+2)*256+PEEK(OFS+1) 'address of code
270 DEF USR0=OFC 'point to code and move in code bytes
280 FOR I = 0 TO LEN(C$)-1
290  READ S$
300  POKE OFC+I,VAL("&h"+S$)
310 NEXT I
320 OT=OFC+6 : OS=OFC+5 : OH=OFC+3
330 SOFS=VARPTR(#2)+188
340 POKE OFC+8,SOFS AND &HFF : POKE OFC+9,SOFS\256
350 'get fat sector
360 POKE OT,0 :POKE OS,2 :POKE OFC+2,DRV
370 GOSUB 1110 ' read sector
380 N=0 'Get the data bytes in array SS; SS(0)=4095 => 320kb format
390 FOR I = 0 TO 474 STEP 3
400  B1=PEEK(I+SOFS)
410  B2=PEEK(I+1+SOFS)
420  B3=PEEK(I+2+SOFS)
430  SS(N)=B1+(B2 AND &HF)*256
440  SS(N+1)=(B2 AND &HF0)\16+B3*16
450  N=N+2
460 NEXT I
470 IF SS(0)=4095 THEN DSD=-1 ELSE DSD=0
480 PRINT #1, "File Allocation Table:";CR$;"   ";
490 FOR I=0 TO 15 :PRINT #1, USING"\  \";" --"+HEX$(I); :NEXT I
500 PRINT #1, SPC(3);"Tracks"
510 PRINT #1, "00- "; :T=0
520 FOR I=0 TO 314-DSD*2 STEP 16
530  FOR K=0 TO 15
540 IF SS(I+K)=0 THEN FSEC=FSEC+1
550   PRINT #1, USING "\  \";RIGHT$("00"+HEX$(SS(I+K)),3);
560   IF I+K=314-DSD*2 THEN 600
570  NEXT K
580  PRINT #1, USING "###";T;T+1;T+2
590  PRINT #1, RIGHT$("0"+HEX$((I+16)\16),2)"- "; :T=T+2
600 NEXT I
610 PRINT #1, SPC(20+DSD*8);
620 PRINT #1, USING "###";T;T+1  :PRINT #1," ";SPC(1-DSD);
630 IF DSD THEN 660
640 FOR I=5 TO 20 : PRINT#1,RIGHT$("  "+STR$((I MOD 8)+1),4); :NEXT I
650 PRINT #1," << Sectors" :GOTO 730
660 FOR H=.9 TO 4 STEP .2
670 FOR S=7 TO 14 STEP 2
680 PRINT#1,STR$(INT(H) MOD 2);":";RIGHT$(STR$(S MOD 8),1);
690 H=H+.2
700 NEXT S,H
710 PRINT#1," << Hd:Sec"
720 PRINT#1,"  ";
730 ' Get the Directory
740 HD$="Name     Ext MM/DD/YY HH:MM S/C Length"
750 FOR S=3 TO 6-3*DSD
760 IF S>7 THEN POKE OH,1
770  POKE OS,(S MOD 8)+1
780  GOSUB 1110 ' read sector
790  FOR I=0 TO 15
800   N$=""
810   FOR X=0 TO 31
820    N$=N$+CHR$(PEEK(I*32+X+SOFS))
830   NEXT X
840   NA$((S-3)*16+I)=N$
850  NEXT I
860 NEXT S
870 PRINT #1, FSEC;"Free S/C,";512*(1-DSD)*FSEC;"Bytes free"
880 PRINT #1,"Directory:";CR$;HD$;"  ";HD$
890 FOR I=0 TO 63-DSD*48
900 IF LEFT$(NA$(I),1)<>CHR$(&HE5) THEN 930
910 IF MID$(NA$(I),2,1)=CHR$(&HF6) THEN I=64-DSD*48 : GOTO 1060
920 IF DS$="n" OR DS$="N" THEN MID$(NA$(I),1,1)="*" ELSE 1070
930 PRINT #1, LEFT$(NA$(I),8);" ";MID$(NA$(I),9,3);
940 B1=ASC(MID$(NA$(I),25,1)) : B2=ASC(MID$(NA$(I),26,1))
950 B3=ASC(MID$(NA$(I),28,1)) : B4=ASC(MID$(NA$(I),27,1))
960 B5=ASC(MID$(NA$(I),32,1)) : B6=ASC(MID$(NA$(I),31,1))
970 B7=ASC(MID$(NA$(I),30,1)) : B8=ASC(MID$(NA$(I),29,1))
980 B9=ASC(MID$(NA$(I),23,1)) : BA=ASC(MID$(NA$(I),24,1))
990 PRINT #1," ";RIGHT$(STR$(100+(B1 AND &HE0)\32+(B2 AND 1)*8),2);
1000 PRINT #1,"-";RIGHT$(STR$(100+(B1 AND &H1F)),2);
1010 PRINT #1,"-";RIGHT$(STR$((B2 AND &HFE)\2+80),2);
1020 PRINT #1," ";RIGHT$(STR$(100+BA\8),2);
1030 PRINT #1,":";RIGHT$(STR$(100+B9\32+(BA AND &H7)*8),2);
1040 PRINT #1, USING "\  \";" "+RIGHT$("00"+HEX$(B3*256+B4),3);
1050 PRINT #1, USING "#######";(B5*256+B6)*65536!+B7*256+B8;
1060 IF POS(0)>72 THEN PRINT #1,  ELSE PRINT #1, "  ";
1070 NEXT I
1080 IF DEV$="LPT1:" THEN LPRINT CR$;DATE$,TIME$;CHR$(27)"2";CHR$(18);CHR$(12)
1090 CLOSE #1
1100 END
1110 RET=USR0(0)
1120 IF RET<>0 THEN RET=USR0(0) 'do a retry on error
1130 IF RET<>0 THEN PRINT"Disk error status: ";RIGHT$("0"+HEX$(RET),2) :END
1140 RETURN
1150 SAVE "LDIR.BAS"
etry on error
1130 IF RET<>0 THEN PRINT"Disk error status: