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:
file: /Techref/DOS/disk/FAT_PRNT.BAS, 4KB, , updated: 1982/8/15 11:53, local time: 2024/8/14 22:22,
18.224.62.52:LOG IN
|
©2024 These pages are served without commercial sponsorship. (No popup ads, etc...).Bandwidth abuse increases hosting cost forcing sponsorship or shutdown. This server aggressively defends against automated copying for any reason including offline viewing, duplication, etc... Please respect this requirement and DO NOT RIP THIS SITE. Questions? <A HREF="http://sxlist.com/TECHREF/DOS/disk/FAT_PRNT.BAS"> DOS disk FAT_PRNT</A> |
Did you find what you needed? |
Welcome to sxlist.com!sales, advertizing, & kind contributors just like you! Please don't rip/copy (here's why Copies of the site on CD are available at minimal cost. |
Welcome to sxlist.com! |
.