See all articles from QL Hacker's Journal 2
This program started out as an attempt to examine a disk with corrupted files. The problem may have been with my disk drive. Just a suggestion to others; try reading the disk in another drive before you give up on it. At any rate don’t write anything to the disk!
Before I knew it I had contracted Babbage’s ailment* (which often happens to programmers) and just couldn’t stop improving (messing with) the program. It is in SuperBasic and uses Toolkit 2. With it I can read sectors on a disk that will crash the machine when you try to do DIR in the usual way. But now it shows the Disk Header information, finds which blocks might have files starting in them, displays the mapping of the blocks, gets File Header info from the files, if it can, (as well as from the directory) so you might even recover some ‘erased’ files.
It will read blocks in the ‘logical’ sequence or you can choose any block for reading. It will transfer a contiguous group of blocks into ram1_, and do a HEX/ASCII dump for me.
In line with Babbage’s ailment, I’d like to have it handle formats other than the 720K(1440 sector) standard QL style, do a little more “expert’ analysis and statistical summarization, and ultimately see if we can “fix-up” bad disks by appropriate selective surgical writing to just the right bits, bytes, sectors, blocks, tracks, files, etc.
Right now ‘diskinfo12’ is a little under 20K in size, and as you can tell, I consider it still under development.
*Babbage’s ailment is not knowing when to stop or leave well enough alone. If it ain’t broke you keep messing with it until it ain’t fixed.
100 REMark read disk header maps, locate files, read
directory data
110 REMark diskinfo12
120 TK2_EXT
130 r$="" :REMark a recovery string
140 ALTKEY 'r','run',''
150 ALTKEY 'R','RUN',''
160 REDEF_TV :CSIZE 0,0
170 dateOK
180 PRINT "rest is available" : PAUSE 30
190 gfh = 0 :REMark a flag for get_file_hdrs
200 explain
205 prompt
210 OPEN #3,'flp1_*d2d'
220 h$=""
230 track = 0
240 side = 0
250 FOR sectr = 1,4,7
260 GET #3\sectr+(side*256)+(track*65536), a$
270 h$=h$&a$
280 NEXT sectr
290 CLOSE #3
300 OPEN_NEW #3, ram1_hdrstrg
310 PRINT #3, h$
320 CLOSE #3
330 CLS#0
340 look_at
350 PRINT #0,,"any key for location of files, etc."
360 PAUSE
370 CLS#0
380 locafile
390 PRINT #0,,"any key for file allocation table"
400 PAUSE
410 CLS#0
420 fatable
430 PRINT #0,,"any key for reading blocks(or directory
data)"
440 PAUSE
450 block_read
460 PRINT #0,,"For another look try ALT-R"
470 STOP
480 :
490 REMark - - - - - end of main program - - - - - - - - - -
- - - - -
500 :
510 REMark = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = =
520 :
530 REMark - - - - - beginning of procedures and functions -
- - - - -
540 :
550 REMark -- file allocation table display -- -- -- F A
T A B L E --
560 DEFine PROCedure fatable
570 CLS
580 clean = 0 : erased = 0 : bad = 0 :col = 0 : nextcol = 25
590 start = 97
600 FOR i = start TO LEN(h$) STEP 3
610 high = 0 : low = 0
620 b$=""
630 PRINT TO col;"B#";(i-start)/3;"=";
640 FOR j = 0 TO 2
650 b$=b$&HEX$(CODE(h$(i+j)),8)
660 END FOR j
670 b2$=b$(1 TO 2)
680 IF b2$="FE" :bad = bad + 1
690 IF (b2$="FD" AND b$(3 TO )<>"FFFF"): erased = erased + 1
700 IF (b2$="FD" AND b$(3 TO )="FFFF") : clean = clean + 1
710 high = HEX(b$(1 TO 3)) : low = HEX(b$(4 TO 6))
720 PRINT b$! high;".";low,
730 col = col + nextcol
740 IF ((col+15)>(3*nextcol)) : col = 0
760 END FOR i
770 PRINT clean;" clean blocks",erased;" blocks erased
";bad;" blocks unusable"
780 END DEFine fatable
790 :
800 REMark -- look at disk header information -- -- -- L
O O K _ A T --
810 :
820 DEFine PROCedure look_at
830 CLS
840 PRINT h$(1 TO 14),"random # =
";256*CODE(h$(16))+CODE(h$(15)),
850 PRINT "number of updates = ";
860 PRINT
CODE(h$(20))+256*(CODE(h$(19))+256*(CODE(h$(18))+256*(C-
ODE(h$(17)))))
870 PRINT"Sectors->","free","good","total","#/track
#/cylinder #/block"
880 PRINT,,CODE(h$(22))+256*CODE(h$(21)),
890 PRINT CODE(h$(24))+256*CODE(h$(23)),
900 PRINT CODE(h$(26))+256*CODE(h$(25))," ";
910 PRINT CODE(h$(28))+256*CODE(h$(27))," ";
920 PRINT CODE(h$(30))+256*CODE(h$(29)),,
930 PRINT CODE(h$(34))+256*CODE(h$(33))\
940 PRINT\CODE(h$(32))+256*CODE(h$(31));" tracks";
950 PRINT" with a sector offset per track of ";CODE(h$(40))
+256*CODE(h$(39))
960 dirlen = 512*(CODE(h$(36)))+256*CODE(h$(35))
970 dirlen = dirlen +(CODE(h$(38))+256*CODE(h$(37)))-64
980 PRINT "Directory takes ";CODE(h$(36))+256*CODE(h$(35));
990 PRINT " sectors + ";CODE(h$(38))+256*CODE(h$(37));
1000 PRINT " bytes which implies ";dirlen/64;" files"
1010 PRINT \"logical to physical table"
1020 FOR i = 41 TO 58
1030 PRINT CODE(h$(i)),
1040 END FOR i
1050 PRINT \ "physical to logical table"
1060 FOR i = 59 TO 76
1070 PRINT CODE(h$(i)),
1080 END FOR i
1090 PRINT\ "Spare 20 bytes available for creative uses ! !"
1100 FOR i = 77 TO 96
1110 PRINT CODE (h$(i)),
1120 END FOR i
1130 END DEFine look_at
1140 :
1150 REMark -- locate start of files -- -- -- - L O C
A F I L E --
1160 :
1170 DEFine PROCedure locafile
1180 CLS
1190 f$="#" : REMark found files
1200 e$="~" : REMark erased files ?
1210 start = 97
1220 col = 0 : nextcol = 25
1230 fls = 0 : ers = 0
1240 FOR i = start TO LEN(h$) STEP 3
1250 high = 0 : low = 0
1260 b$=""
1270 FOR j = 0 TO 2
1280 b$=b$&HEX$(CODE(h$(i+j)),8)
1290 END FOR j
1300 high = HEX(b$(1 TO 3)) : low = HEX(b$(4 TO 6))
1310 blck$ =(i-start)/3
1320 IF high = 3968 : PRINT "mapping sector at block ";blck$
1330 IF high = 0 : PRINT "directory block ";blck$
1340 IF b$="FDFFFF": PRINT TO col;"unused block @ ";blck$,
:col=col+nextcol
1350 IF (b$(1 TO 2) ="FD" AND b$(3 TO) <> "FFFF") : PRINT TO
col; "erased block @ ";blck$,:col =col + nextcol
1360 IF b$(1 TO 2) ="FE" : PRINT TO col; "nogood block @
";blck$,:col = col + nextcol
1370 IF ((low = 0) AND ( high>0 ) AND (high <480)) : PRINT
TO col;"file# ";high;" at block ";blck$, :fls = fls +1
:fls$=fls:f$=f$&fls$&"@"&blck$&"#" : col = col + nextcol
1380 IF ((low = 0) AND (high >3968)) : PRINT \ TO
nextcol/2;" ? ? ERASED FILE STARTING @ block ";blck$\ :
col = 0 :ers = ers + 1: ers$ = ers: e$ = e$&"#?"&ers$&"
@"&blck$&"~"
1390 IF col >2*nextcol : col = 0
1400 END FOR i
1420 PRINT\ "Found the starting place for ";fls;" files"
1430 PRINT "Found possible starting place for ";ers;" erased
files"
1440 PRINT #0, "OK that's the end of locating the start of
";fls;" files"
1450 END DEFine locafile
1460 :
1470 REMark -- read blocks in sequence -- -- -- B L O C
K _ R E A D --
1480 DEFine PROCedure block_read
1490 REDEF_TV : CSIZE 0,0 : MODE 4
1495 CLS
1500 CLS#0
1510 DIM sectab(3,3):RESTORE
1520 DATA 0,3,6,1,4,7,2,5,8 :REMark usual sector jumps
1530 FOR i = 1 TO 3
1540 FOR j = 1 TO 3
1550 READ sectab(i,j)
1560 END FOR j
1570 END FOR i
1580 blck = -1
1590 blck$ = "0"
1600 REPeat query
1605 IF blck = 479 : blck = 478
1610 PRINT"Enter a number (0 to 479) for a specific
block"\"'D' = read Directory headers / 'G' = Get file
headers "\"'F' = locate Files / 'R' = attempt Recovery
of blocks "\"'L' = Look at disk data / 'M' = see
Mapping of blocks / 'Q' = Quit"
1620 IF LEN(r$)<>0 :PRINT "'H' = HEX / ASCII Dump of
recovered blocks"
1630 INPUT "(ENTER for Block #";blck+1;" '-' for previous
Block,",blck$
1640 IF blck$ == "q" :EXIT query
1650 IF blck$ == 'd' : PAPER 4: INK 0:read_dir: prompt :
block_read
1660 IF blck$ == 'g' : PAPER 0: INK 4:get_file_hdrs : prompt
: block_read
1670 IF blck$ == 'r' :PAPER 2: INK 0:block_recover :prompt :
block_read
1680 IF blck$ == 'l' :PAPER 0:INK 2:look_at : prompt :
block_read
1690 IF blck$ == 'f' :PAPER 0:INK 4:locafile: prompt :
block_read
1700 IF blck$ == 'm' :PAPER 0:INK 6:fatable : prompt :
block_read
1710 IF blck$ == 'h' :PAPER 4:INK 0:recread : prompt :
block_read
1720 IF ((blck$ = "-") AND (blck >0)) :blck = blck - 1
:blck$ = blck
1730 IF ((blck$ = "-") AND (blck = 0)):PRINT; "this is the
zeroth block can't go back any more!":blck$ = "0" : blck
= 0
1735 IF ((blck$ = "") AND (blck<479)) : blck = blck + 1 :
blck$ = blck
1740 IF ((blck$ = "") AND (blck=479)) :PRINT;" this is the
final block can't go any further": blck$ = "479" : blck
= 479
1760 blck = blck$
1770 :
1780 REMark sometimes we have read errors, etc.
1790 WHEN ERRor
1800 PRINT\"There's been a hitch somewhere so let's try
something else .."\
1810 RETRY 1600 :REMark repeat query
1820 END WHEN
1830 :
1840 block_find
1850 block_get
1860 FOR sec = 0 TO 2
1870 PRINT\"BLOCK ";blck;" part ";sec+1,,"side
";side,"track ";track, "sector
";(sctrs(sec+1))\
1880 PRINT b$((1+(sec * 512)) TO ((sec + 1)* 512))
1890 prompt
1900 END FOR sec
1910 PRINT "that was block ";blck
1920 IF blck = 0 :PRINT " which is the disk header and
mapping block"\,"ENTER 'L' to look at disk info/ ENTER
'F' to find file locations"\,"ENTER 'M' for mapping
data"
1930 IF blck = 1: PRINT " probably the start of the
directory block(s) "\,"ENTER 'D' for directory header
translations"\,"ENTER 'G' to get file headers"
1940 IF gfh = 1 : PRINT,"ENTER 'R' to recover (rescue)
blocks"
1950 IF blck = 479 : PRINT " That's the last block on a 720K
disk"
1960 END REPeat query
1970 CLS
1980 PRINT #0, "Try ALT-R to run another"
1990 STOP
2000 END DEFine block_read
2010 :
2020 REMark -- read block into b$ -- -- -- -- B L O C
K _ G E T --
2030 DEFine PROCedure block_get
2040 OPEN #3,'flp1_*d2d'
2050 b$=""
2060 FOR i = 1 TO 3
2070 GET #3\sctrs(i)+(side*256)+(track*65536), a$
2080 b$=b$&a$
2090 END FOR i
2100 CLOSE #3
2110 END DEFine block_get
2120 :
2130 REMark -- find side,track,sectors of block -- B L O C
K _ F I N D --
2140 DEFine PROCedure block_find
2150 PRINT "BLOCK# ";blck,,
2160 side = 2*((blck/2) - INT(blck/2))
2170 PRINT "side ";side,
2180 track = INT(blck/6)
2190 PRINT "track ";track,
2200 begin = ((INT(blck/2)) MOD 3) + 1
2210 PRINT "sectors ";
2220 DIM sctrs(3)
2230 FOR i = 1 TO 3
2240 sctrs(i) = ((sectab(begin,i)+5*track) MOD 9) + 1
2250 PRINT " ";sctrs(i);
2260 END FOR i
2270 END DEFine block_find
2280 :
2290 REMark -- read directory headers -- -- -- -- R E A
D _ D I R --
2300 DEFine PROCedure read_dir
2310 CLS
2320 file_no = 1 :blck = 0 : mark = 0
2330 REPeat reeding
2340 blck = blck +1
2350 PRINT\
2360 block_find
2370 PRINT\
2380 block_get
2390 dirstart = 1
2400 IF blck = 1 : dirstart = 65
2410 END IF
2420 FOR jj = dirstart TO LEN(b$) STEP 64
2430 dirstr$ = b$(jj TO jj + 63)
2440 mark = mark + 64
2450 IF (mark > dirlen) : EXIT reeding
2460 PRINT\ "File # ";file_no;
2470 read_dirfilehdr
2480 file_no = file_no + 1
2490 END FOR jj
2500 END REPeat reeding
2510 PRINT "That's the last file in the directory"
2520 END DEFine read_dir
2530 :
2540 REMark - read directory file header R E A D _ D I R F
I L E H D R --
2550 DEFine PROCedure read_dirfilehdr
2560 PRINT " Length is ";
2570 hx$=""
2580 FOR kk = 1 TO 4
2590 hx$ = hx$ & HEX$ (CODE(dirstr$(kk)),8)
2600 END FOR kk
2610 PRINT HEX(hx$),"(";(HEX(hx$)-64);" plus this 64 byte
header)"
2620 PRINT "Access code is "; CODE(dirstr$(5)),
2630 type = CODE(dirstr$(6))
2640 PRINT "Type ";type;" ";
2650 SELect ON type
2660 ON type = 0 : PRINT "(Data)"
2670 ON type = 1 : PRINT "(Task)"
2680 ON type = 2 : PRINT "(Link)"
2690 = REMAINDER : PRINT "(????)"
2700 END SELect
2710 PRINT "file information (if task file) = ";
2720 hx$=""
2730 FOR kk = 7 TO 10
2740 hx$ = hx$ & HEX$ (CODE(dirstr$(kk)),8)
2750 END FOR kk
2760 PRINT hx$,HEX(hx$),dirstr$(7 TO 10)
2770 PRINT "4 bytes not usually used ? ! --->",
2780 hx$=""
2790 FOR kk = 11 TO 14
2800 hx$ = hx$ & HEX$ (CODE(dirstr$(kk)),8)
2810 END FOR kk
2820 PRINT hx$,HEX(hx$)
2830 finaln = 256*CODE(dirstr$(15))+CODE(dirstr$(16))
2840 PRINT "length of file name is ";finaln;" bytes",
2850 IF finaln > 36 : finaln = 36
2860 PRINT "FILENAME IS ";
2870 FOR kk = 17 TO (16+finaln)
2880 PRINT dirstr$(kk);
2890 END FOR kk
2900 PRINT\
2910 DIM time(3)
2920 FOR kk = 0 TO 2
2930 hx$ = ""
2940 FOR tt = 1 TO 4
2950 hx$ = hx$ & HEX$(CODE(dirstr$(tt+(52+kk*4))),8)
2960 END FOR tt
2970 time(kk) = HEX(hx$)
2980 PRINT time(kk),DATE$(time(kk)),
2990 SELect ON kk
3000 = 0 : PRINT " last save "
3010 = 1 : PRINT " last read ( 4 bytes for other uses ?
! )"
3020 = 2 : PRINT " last copy ( 4 bytes for other uses ?
! )"
3030 END SELect
3040 END FOR kk
3050 END DEFine read_dirfilehdr
3060 :
3070 REMark -- Explain what program does -- -- -- -- E X
P L A I N --
3080 DEFine PROCedure explain
3090 CLS
3100 PRINT"This started out as a simple file recovery
exercise"\"but like Topsy 'it just growed'"
3105 PRINT "It looks for flp1_, ram1_, TK2, and 720K (1440
sector) disks"
3110 PRINT"Just keep following the prompts and enjoy "
3120 PRINT "It is in SuperBasic so feel free to modify to
your taste."
3130 PRINT "After asking for the date the program looks at
Block 0"\"In the first 96 bytes are data about the disk
itself"\"The remaining 1440 bytes keep track of where
the files are"
3140 PRINT "The disk info is shown on one screen,
while"\"directory data, and files allocation tables take
160 lines each."
3150 PRINT "Directory data starts in Block 1 "
3160 PRINT "Erased files are not in the directory, but
corrupted ones may be."
3170 PRINT "File headers can be found for erased files"
3180 PRINT "File headers data is usually just the name of
the file"
3190 PRINT"Hopefully this gives you something to work with."
3200 PRINT"Recovery of contiguous blocks is possible and a
"\"simple hex-offset / HEX-dump / ASCII-dump is
available"
3210 END DEFine explain
3220 :
3230 REMark -- a little prompt in #0 -- -- -- -- P R O
M P T -- --
3240 DEFine PROCedure prompt
3250 PRINT #0, "Any key to continue"
3260 PAUSE
3270 CLS#0
3280 END DEFine prompt
3290 :
3300 REMark -- get file headers -- -- -- G E T _ F I L E
_ H D R S --
3310 DEFine PROCedure get_file_hdrs
3320 PRINT\ "Getting headers from files"
3330 DIM fh(fls):DIM fh$(fls,64)
3340 IF ers <> 0 THEN DIM eh(ers):DIM eh$(ers,64)
3350 tmp$ = f$
3360 REPeat stripfls
3370 IF LEN(tmp$) = 1 THEN EXIT stripfls
3380 front = "#" INSTR tmp$ :back = "@" INSTR tmp$
3390 fl_no = tmp$(front+1 TO back-1) : tmp$ = tmp$(back+1
TO)
3400 fh(fl_no) = tmp$( 1 TO ("#" INSTR tmp$)-1)
3410 tmp$ = tmp$(("#" INSTR tmp$) TO )
3420 PRINT\ "File #";fl_no;" @ block ";fh(fl_no)\
3430 blck = fh(fl_no)
3440 block_find
3450 block_get
3460 fh$(fl_no) = b$(1 TO 64)
3470 PRINT \fh$(fl_no)
3480 dirstr$ = fh$(fl_no)
3490 read_file_head
3500 END REPeat stripfls
3510 tmp$ = e$
3520 fl_no = 0
3530 REPeat stripers
3540 IF LEN(tmp$) = 1 THEN EXIT stripers
3550 front = "?" INSTR tmp$ :back = "@" INSTR tmp$
3560 fl_no = tmp$(front+1 TO back-1) : tmp$ = tmp$(back+1
TO)
3570 eh(fl_no) = tmp$(1 TO ("~" INSTR tmp$)-1):tmp$ =
tmp$(("~" INSTR tmp$) TO)
3580 PRINT\"erased ? file #";fl_no;" @ block ";eh(fl_no)\
3590 blck = eh(fl_no)
3600 block_find
3610 block_get
3620 eh$(fl_no)=b$(1 TO 64)
3630 PRINT eh$(fl_no)
3640 dirstr$ = eh$(fl_no)
3650 read_file_head
3660 END REPeat stripers
3670 gfh = 1
3680 END DEFine get_file_hdrs
3690 :
3700 REMark - recover blocks in sequence - B L O C K _ R E
C O V E R --
3710 DEFine PROCedure block_recover
3720 REMark assumes use of Toolkit 2 (TK2_ext)
3730 REMark assumes get_file_hdrs has been used
3740 IF (gfh <> 1) :get_file_hdrs
3760 CLS
3770 PRINT\,, "Summary of files found: "
3780 FOR ii = 1 TO fls
3790 PRINT "file # ";ii;" @ block ";fh(ii);" ";
3800 IF blck$<> 'r' THEN PRINT fh$(ii); :END IF
3810 dirstr$ = fh$(ii)
3820 read_file_head
3830 END FOR ii
3840 IF ers <> 0 THEN PRINT "Potential files, but erased "
:END IF
3850 ii = 1
3860 REPeat efiles
3870 IF ers = 0 OR ers < ii THEN EXIT efiles
3880 PRINT "Possible erased file # ";ii;" at block
";eh(ii);" ";
3890 IF blck$<> 'r' THEN PRINT eh$(ii); :END IF
3900 dirstr$ = eh$(ii)
3910 read_file_head
3920 ii =ii + 1
3930 END REPeat efiles
3940 PRINT\"Note the numbers of the first and last blocks
for recovery"\,"They will be gathered into
RAM1_rstrg"\,,"With luck you may be able to salvage
something."\"ENTER 'B' to return to block_read - - any
other key for recovery process."
3950 ans$ = INKEY$(-1)
3960 IF ans$ == "b" THEN block_read
3970 CLS
3980 DIM sectab(3,3):RESTORE
3990 DATA 0,3,6,1,4,7,2,5,8 :REMark usual sector jumps
4000 FOR i = 1 TO 3
4010 FOR j = 1 TO 3
4020 READ sectab(i,j)
4030 END FOR j
4040 END FOR i
4050 r$=""
4060 INPUT "Starting from block number ? ";from_block
4070 INPUT "Ending with block number ?"\"(can be same as
starting block to get just one block ";to_block
4080 IF to_block < from_block THEN to_block = from_block
4090 FOR blck = from_block TO to_block
4100 PRINT
4110 block_find
4120 block_get
4130 r$=r$&b$
4140 END FOR blck
4150 OPEN_NEW #3,ram1_rstrg
4160 PRINT #3, r$
4170 CLOSE #3
4180 PRINT \"Blocks from ";from_block;" to ";to_block;" have
been saved as RAM1_rstrg"\
4190 PRINT\ "the recovery string is r$ and may be examined
as a hex/ascii dump"
4200 END DEFine block_recover
4210 :
4220 REMark DATEOK and REST
4230 :
4240 REMark -- -- -- -- -- -- -- -- -- -- -- --
R E S T --
4250 :
4260 REMark a screen blanker you can invoke when you're
called away etc.
4270 :
4280 DEFine PROCedure rest
4290 OPEN#4,scr
4300 WINDOW#4,512,256,0,0
4310 PAPER#4,0:INK#4,4:CLS#4
4320 doze=DATE
4330 PAUSE
4340 wake=DATE
4350 CLOSE#4
4360 WMON
4370 PRINT DATE$(doze),"rested"\DATE$(wake),"awoken"
4380 d$=DATE$(wake-doze)
4390 AT 3,12:PRINT d$(13 TO),"napped"
4400 END DEFine rest
4410 :
4420 REMark -- asks if datestamp is set ? -- -- -- -- D
A T E O K --
4430 DEFine PROCedure dateOK
4440 CLS
4450 CSIZE 2,1
4460 PRINT DATE$,,DAY$
4470 PRINT\"Is D A T E O.K. ?"
4480 PAUSE 20
4490 IF INKEY$(-1)=="n" THEN chngdate
4500 CSIZE 0,0
4510 END DEFine dateOK
4520 :
4530 REMark -- to set date using ENTER -- -- -- -- C H N
G D A T E --
4540 DEFine PROCedure chngdate
4550 CSIZE 1,0
4560 PRINT\ "enter numeric values for SDATE"
4570 PRINT\"(ENTER will place commas )"
4580 CSIZE 0,0
4590 PRINT"year month day hour min sec"
4600 DIM d(6)
4610 FOR i=1 TO 6
4620 AT 13,(((i-1)*13)/2):
4630 INPUT d(i);","
4640 END FOR i
4650 SDATE d(1),d(2),d(3),d(4),d(5),d(6)
4660 dateOK
4670 END DEFine chngdate
4680 :
4690 REMark last line as of Nov. 10th 1990 6am ...
4700 :
4710 REMark -- read file headers -- -- R E A D _ F I L E _
H E A D -- --
4720 DEFine PROCedure read_file_head
4730 ok = 0
4740 hx$=""
4750 FOR kk = 1 TO 4
4760 hx$ = hx$ & HEX$ (CODE(dirstr$(kk)),8)
4770 END FOR kk
4780 IF HEX(hx$) = 64 AND blck$ <> 'r' : PRINT " looks OK
once ";
4790 IF HEX(hx$) = 64 : ok = ok + 1
4800 ELSE PRINT " bytes 1-4 = ";dirstr$(1 TO 4);
4810 END IF
4820 IF (CODE(dirstr$(5)) + CODE(dirstr$(6)) = 0) AND blck$
<> 'r' THEN PRINT " looks OK twice";
4830 IF (CODE(dirstr$(5)) + CODE(dirstr$(6)) = 0):ok = ok +
1
4840 ELSE PRINT " bytes 5-6 = ";dirstr$(5 TO 6);
4850 END IF
4860 hx$=""
4870 FOR kk = 7 TO 10
4880 hx$ = hx$ & HEX$ (CODE(dirstr$(kk)),8)
4890 END FOR kk
4900 IF (HEX(hx$) = 0) AND blck$<>'r' :PRINT " looks OK
thrice ";
4910 IF (HEX(hx$) = 0) :ok = ok + 1
4920 ELSE PRINT " bytes 7-10 = ";dirstr$(7 TO 10);
4930 END IF
4940 hx$=""
4950 FOR kk = 11 TO 14
4960 hx$ = hx$ & HEX$ (CODE(dirstr$(kk)),8)
4970 END FOR kk
4980 IF (HEX(hx$) = 0) AND blck$<>'r' THEN PRINT " looks OK
for 4 ";
4990 IF (HEX(hx$) = 0) THEN ok = ok + 1
5000 ELSE PRINT " bytes 11-14 = ";dirstr$(11-14);
5010 END IF
5020 finaln = 256*CODE(dirstr$(15))+CODE(dirstr$(16))
5030 REMark PRINT "length of file name is ";finaln;" bytes",
5040 IF finaln > 36 THEN PRINT\ "Filename too long ";
:finaln = 36
5050 END IF
5060 IF blck$ <> 'r' THEN PRINT\ "FILENAME IS ";
5070 FOR kk = 17 TO (16+finaln)
5080 PRINT dirstr$(kk);
5090 END FOR kk
5100 hx$ = ""
5110 FOR kk = 52 TO 64
5120 hx$ = hx$ & HEX$(CODE(dirstr$(kk)),8)
5130 END FOR kk
5140 IF (HEX(hx$) = 0) AND blck$<>'r' : PRINT," Looks OK at
end"
5150 IF (HEX(hx$) = 0) :ok = ok + 1
5160 ELSE PRINT," Strange ending ";hx$
5170 END IF
5180 IF ok = 5 AND blck$ = 'r' :PRINT ,,"Looks OK "
5190 END DEFine read_file_head
5200 :
5210 REMark -- redefine tv -- -- -- -- -- -- -- R E D
E F _ T V --
5220 DEFine PROCedure REDEF_TV
5230 WINDOW #0,448,40,32,216
5240 PAPER #0,0: INK #0,7: BORDER #0
5250 OPEN #1,con_448x200a32x16_128
5260 PAPER #1,2: INK #1,7: BORDER #1
5270 OPEN #2,con_448x200a32x16_128
5280 PAPER #2,1: INK #2,7: BORDER #2
5290 MODE 4
5300 END DEFine REDEF_TV
5310 :
5320 :
5330 REMark -- recread -- -- -- -- -- -- -- -- R
E C R E A D --
5340 REMark to take r$ and read it in debugd style
5350 DEFine PROCedure recread
5360 CLS
5370 PRINT #0\"Reading from block ";from_block;" to
";to_block;" ";HEX$(LEN(r$),16)
5380 REMark PRINT r$,LEN(r$)\
5390 FOR i = 1 TO LEN(r$) STEP 16
5400 PRINT HEX$(i,16);" ";
5410 FOR j = 0 TO 15
5420 rcode = CODE(r$(i+j))
5430 PRINT HEX$(rcode,8);" ";
5440 END FOR j
5450 PRINT;" ";
5460 FOR j = 0 TO 15
5470 IF CODE(r$(i+j))<> 10 THEN PRINT r$(i+j);
5480 IF CODE(r$(i+j))= 10 THEN PRINT "¼";
5490 END IF
5500 END FOR j
5510 PRINT\
5520 END FOR i
5530 END DEFine recread