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