please dont rip this site

Dos Disk Fat_prnt

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: 2018/9/25 02:43,
TOP NEW HELP FIND: 
54.80.58.121:LOG IN

 ©2018 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?
Please DO link to this page! Digg it! / MAKE! / 

<A HREF="http://www.sxlist.com/techref/DOS/disk/FAT_PRNT.BAS"> DOS disk FAT_PRNT</A>

Did you find what you needed?

 

Welcome to sxlist.com!


Site supported by
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 www.sxlist.com!

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

  .