PROGRAM ASCII C C LOCATE AND RECOVER CORRUPTED ASCII FILES C C C J Doran, Sira Ltd., C South Hill, Chislehurst, Kent, BR7 5EH, England. C Tel: 01 467 2636 Telex: 896649 C C This is a last-ditch program to recover files from a corrupted C disk, in which even the file headers have been lost. It will C read the disk block by block and display each block in ASCII C on the terminal. It will then ask whether you want that block C written to an output file. Answer 0 if not, >2 to write it to C file FOR00n.DAT, where n is the number you specify. C C Task build as: C C >TKB C TKB>ASCII,ASCII/-SP=ASCII C TKB>/ C ENTER OPTIONS: C TKB>UNITS= C TKB>ACTFIL= C TKB>ASG=SY:1,TI:2,SY:3:4:5:6:7:8:9:10 C TKB>ASG=SY:11:12:13:14...: C TKB>GBLPAT=ASCII:$TYPE:2 ; Re-assign TYPE and C TKB>GBLPAT=ASCII:$ACCPT:2 ; ACCEPT to LUN 2 C TKB>// C C Based on HEADER program by W P HELMAN, C "The Multi-tasker", v11 No2 pp71-77 C C Modifications Record: C ===================== C 25-Jul-83 CJD C Increase block size to 3072 bytes to allow reading of big magtapes C (e.g. as written by DSC or BRU). C Do the block display in the same way as the file write, treating C control chars as line terminators. Eliminates need for terminal reset C and makes it easire to see what you're getting. C C PARAMETER BLKSIZ=3072 ! Block size. 512 for disk, > for magtape. PARAMETER NMAX=12 ! Max no of files+2 BYTE B(BLKSIZ),NAME(9),EXT(3),DEV(2) INTEGER*2 A(BLKSIZ/2),IPR(6),ISB(2),NBLK(2) INTEGER*4 NBLOCK,NREC EQUIVALENCE (NBLOCK,NBLK),(A,B),(DEV,IDEV) C DATA IPR(1),IPR(2)/1,BLKSIZ/ DATA IFNAM,IFTYP,IFVER/"30,"33,"34/ ! File ID pointers <*> DATA JUIC1,JUIC2,JCRDT/"12,"11,"110/ ! May be system dependent <*> DATA ICHH,IESQN,IUSE/7,"57,"63/ ! <*> C TYPE 1 1 FORMAT('$Device: ') ACCEPT 2,IDEV 2 FORMAT(1A2) IDEV=IDEV.AND."57537 ! Make sure upper case TYPE 3 3 FORMAT('$Unit = ') ACCEPT 72,IUNIT CALL ASNLUN(1,IDEV,IUNIT) TYPE 4 4 FORMAT('$Start at block (0=current, magtape only) = ') ACCEPT 72,NBLOCK C Magtapes must be positioned by rewind and space forward. The disk drivers C do positioning automatically. IF(DEV(1).NE.'M' .OR. NBLOCK.EQ.0) GOTO 8 CALL WTQIO("2400,1,6,,ISB,IPR,IDS) ! Rewind tape C Space to first block required. Have to do one block at a time because C a multiple space block instruction fails on tape marks. IF(NBLOCK.LE.0) GOTO 9 DO 6 NREC=1,NBLOCK 5 CALL WTQIO("2420,1,6,,ISB,IPR,IDS) ! (IPR(1) initialised to 1) IF(ISB(1).EQ."302) STOP 'End of tape' IF(ISB(1).NE.1) TYPE 61,NREC,ISB,IDS ! Test for error 6 CONTINUE 8 NBLOCK=NBLOCK-1 9 IF(NBLOCK.LT.0) NBLOCK=0 CALL GETADR(IPR,A) ! Load address of array C 10 NBLOCK=NBLOCK+1 ! Get next logical block IPR(5)=NBLK(1) IPR(4)=NBLK(2) A(1)=0 A(4)=0 CALL WTQIO(512,1,6,,ISB,IPR,IDS) ! Read by logical block IF(ISB(1).EQ."302 .OR. ISB(1).EQ."354) STOP 'End of volume' IF(ISB(1).NE.1) TYPE 61,NBLOCK,ISB,IDS ! Test for error IF(ISB(1).NE.1) GOTO 10 ! and try next block IF((A(1).NE."27027).OR.(A(4).NE."401)) GOTO 50 ! Test for header <*> CALL R50ASC(9,A(IFNAM),NAME) CALL R50ASC(3,A(IFTYP),EXT) IVERS=A(IFVER) TYPE 11, NBLOCK,NAME,EXT,IVERS,(B(I),I=JCRDT,JCRDT+"14), 1 B(JUIC1),B(JUIC2),A(ICHH) GOTO 10 C 11 FORMAT('0Block: ',I8,', Header for file:',/, 1 X,9A1,'.',3A1,';',O5,2X,2A1,'-',3A1,'-',2A1,X,2A1, 2 ':',2A1,':',2A1,' [',O3,',',O3,'] ',O7) C 61 FORMAT(' QIO error, block:',I8,' ISB(1),ISB(2),$DSW =',3O7) C C Not header, treat as file block 50 IF(IPR(2).EQ.0) GOTO 10 ! Skip empty block TYPE 51,NBLOCK,IPR(2) 51 FORMAT('0Block ',I8,', Size:',I5) CALL WRITBL(2,B,ISB(2)) 70 TYPE 71,NBLOCK 71 FORMAT(//,'$Copy block ',I8,' to file No = ') ACCEPT 72,N 72 FORMAT(I7) IF(N.EQ.0) GOTO 10 ! Not wanted IF(N.LT.0) STOP IF(N.LE.2 .OR. N.GT.NMAX) GOTO 70 ! Illegal LUN CALL WRITBL(N,B,ISB(2)) GOTO 10 END C Write out block as a series of lines, treating all non-printing chars C as line terminators to save a lot of editing out of byte counts. SUBROUTINE WRITBL(N,B,LENGTH) BYTE B(LENGTH) I=0 80 I=I+1 IF(I.GT.LENGTH) RETURN IF(B(I).LT."40 .AND. B(I).NE."11) GOTO 80 J=I 90 IF(J.EQ.LENGTH .OR. (J-I+1).EQ.131) GOTO 100 J=J+1 IF(B(J).GE."40 .OR. B(J).EQ."11) GOTO 90 J=J-1 100 IF(N.EQ.2) THEN WRITE(N,101) (B(K),K=I,J) 101 FORMAT(X,A1) ! TI: HAS FORTRAN carriage control ELSE WRITE(N,102) (B(K),K=I,J) 102 FORMAT(A1) ! Files have LIST c-c, so no space ENDIF I=J GOTO 80 END