              <<< ISVNET::DISK$OTHER:[NOTES$LIBRARY]VMS.NOTE;1 >>>
                           -< VMS Operating System >-
================================================================================
Note 307.2                      Undelete utility?                         2 of 4
XLIB::SCHAFER "Mark Schafer, ISV Tech. Support"     283 lines  16-DEC-1991 16:33
                               -< undelete.for >-
--------------------------------------------------------------------------------
      PROGRAM  UNDELETE  !!-** UNDELETE A PROGRAM ON ODS-2 VAX DISK **-!!
      IMPLICIT NONE      ! MAKE SURE ALL VARIABLES ARE DEFINED
 
!  REGULAR PROGRAM VARIABLES
 
      CHARACTER*86 FILNAM,RECNAM,INFLNM*86,DCLCOM*135,DEVICE*10,ANSWER*1
      INTEGER*4    SEARCH,HEADRS,FILVER,LENCHK,NOSP,VBN,IOST
 
!  HOME BLOCK
 
      BYTE BYTE4(4),BYTE8(8),BYTE13(13),STRUCT
      INTEGER*2 MAPVBN,MAPSIZ
      INTEGER*4 MAXFIL
 
!  FILE HEADER DATA
                              
      BYTE      RECORD(512)
      INTEGER*2 INFID(3),EXTFID(3),BAKFID(3),FILID(3),CHKSUM
      INTEGER*4 FILCHR
 
     0 EQUIVALENCE ( FILID(1), RECORD(9) ),   ! MAKE IT EASY TO READ DATA
     1             (EXTFID(1), RECORD(15)),   ! FROM THE HEADER RECORD.
     2             (   FILCHR, RECORD(53)),
     3             (BAKFID(1), RECORD(67)),
     4             (   CHKSUM,RECORD(511))
 
 
!  GET DEVICE, AND FILE NAME OR FILE ID.
 
      TYPE *,' '
      TYPE *,'   THIS PROGRAM RECOVERS DELETED FILES FROM A FILES-11 ODS-2 DISK'
      TYPE *,' '
10    WRITE(*,'(4X,''DEVICE --> '',$)')
      READ(*,'(A)')DEVICE
      CALL STR$UPCASE(DEVICE,DEVICE)
      DEVICE=DEVICE(1:INDEX(DEVICE,':'))
      IF(NOSP(DEVICE).EQ.0) THEN
        TYPE *,'ENTER A DEVICE WITH A '':'' ON THE END.'
        GOTO 10
      ENDIF
20    TYPE *,'   DO YOU WANT TO ENTER --> 0) FILE ID  OR,'
      WRITE(*,'(4X,''                     --> 1) FILE NAME    (0/1) '',$)')
      READ (*,'(I1)')SEARCH
      IF (SEARCH.EQ.0) THEN
        WRITE(*,'(4X,''WHAT IS THE FILE ID XXXX,YYY,ZZZ ?  '',$)')
        READ(*,'(I,I,I)')INFID(1),INFID(2),INFID(3)
        IF (INFID(1).EQ.4.AND.INFID(2).EQ.4.AND.INFID(3).EQ.0) THEN
          TYPE *,' '


          TYPE *,'THAT IS THE MASTER FILE DIRECTORY. DON''T MESS WITH IT.'
          GOTO 160
        ENDIF    ! WE NEED TO DO THIS OR GET A LOCKED TARGET STREAM IN FINDIR
        IF (INFID(1).LE.0) THEN
          TYPE *,' '
          TYPE *,'LOWEST RECORD # = 1.'
          GOTO 160
        ENDIF
      ELSE
        WRITE(*,'(4X,''FILE NAME --> '',$)')
        READ(*,'(A)')FILNAM
        CALL STR$UPCASE(FILNAM,FILNAM)
        FILVER=INDEX(FILNAM,';')
      ENDIF
      TYPE *,' '
             
     0 OPEN(1,FILE=DEVICE(1:NOSP(DEVICE))//'[000000]INDEXF.SYS',SHARED,
     1 ACCESS='DIRECT',FORM='UNFORMATTED',RECORDTYPE='FIXED',STATUS='OLD')
 
!  READ THE HOME BLOCK TO GET THE ODS STRUCTURE, THE MAP AREA, THE MAX FILES,
!  AND THE MAP SIZE SO WE CAN GET BLOCKS WICH HEADERS START AFTER.
 
      READ(1,REC=2) BYTE13,STRUCT,BYTE8,MAPVBN,BYTE4,MAXFIL,MAPSIZ
      IF (STRUCT.NE.2) THEN
        TYPE *,'THIS IS NOT A FILES-11 ODS-2 DISK.'
        GOTO 150
      ENDIF
      HEADRS=MAPVBN+MAPSIZ
 
      IF (SEARCH.EQ.0) THEN                          ! IF LOOKING BY FILE ID
        VBN=INFID(1)+HEADRS-1
        READ(1,REC=(INFID(1)+HEADRS-1),ERR=127) RECORD
        IF (FILID(2).NE.INFID(2)) GOTO 140           ! HAS HEADER BEEN REUSED?
        CALL GETNAM(RECORD,RECNAM)                   ! GET FNAM FOR THIS REC
        GOTO 110
      ENDIF
 
!  SEARCH ALL HEADERS UNTIL ONE WITH THE SAME FILE NAME AND VERSION IS FOUND
                                
      VBN=HEADRS
100   VBN=VBN+1
      READ(1,REC=VBN,ERR=130,IOSTAT=IOST) RECORD
      CALL GETNAM(RECORD,RECNAM)
      LENCHK=INDEX(RECNAM,';')-1
      IF (FILVER.GT.0.OR.LENCHK.LE.0) LENCHK=86
      IF (FILNAM.NE.RECNAM(1:LENCHK)) GOTO 100
110  0 CALL FINDIR(BAKFID,HEADRS,DEVICE(1:NOSP(DEVICE)),   ! GET FULL DIR SPEC
     1 RECNAM(1:NOSP(RECNAM)),INFLNM)
      IF (CHKSUM.NE.0.AND.FILID(1).NE.0) THEN
        INFLNM=INFLNM(1:NOSP(INFLNM))//'  --> NOT DELETED' ! FILE STILL ALIVE
        WRITE(*,'(X,A)')INFLNM
        IF (SEARCH.EQ.1) GOTO 100                          ! IF LOOKING BY FNAM
                                                           ! LOOK FOR OTHERS
        TYPE *,'THAT FILE ID IS ALIVE AND DOING WELL.'
        GOTO 150
      ENDIF
      INFLNM=INFLNM(1:NOSP(INFLNM))//'  --> RECOVER? (Y/N)'
 

      WRITE(*,'(X,A,$)') INFLNM(1:NOSP(INFLNM)+1)
      READ (*,'(A)') ANSWER
      IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') THEN
        IF (SEARCH.EQ.1) GOTO 100
        TYPE *,'O.K. FILE WILL STAY DELETED.'
        GOTO 150
      ENDIF
 
!  FINALLY FOUND A FILE TO BRING BACK FROM THE DEAD.  PUT IN THE FILID
!  AND CHKSUM, CLEAR DELETE BIT IN FILCHR AND MAPPING
 
      FILID(1)=VBN-HEADRS+1                          ! FILE ID # IS CURRENTLY 0
      FILCHR=FILCHR.AND.'FFFF7FFF'X                  ! SAY HEADER IS NOW USED
 
!  GET THE CHANGED CHKSUM AND REPLACE THAT TOO
 
      CALL CHECKR(RECORD)                            ! CHECKSUM THE NEW HEADER
      TYPE *,' '
      TYPE *,'REWRITING HEADER AND CHECKSUM.'
      WRITE(1,REC=(FILID(1)+HEADRS-1)) RECORD        ! REWRITE THE NEW HEADER
 
120   IF (EXTFID(1).EQ.0) GOTO 125                   ! IF NO MORE EXT HDRS- END
 
      INFID(1)=EXTFID(1)                             ! INFID IS CUR EXT HDR #
      READ(1,REC=INFID(1)+HEADRS-1) RECORD           ! READ EXT HDR
      CALL GETNAM(RECORD,RECNAM)                     ! GET FNAM IN EXT HDR
      IF (FILNAM.NE.RECNAM(1:INDEX(RECNAM,';')-1)) THEN
        TYPE *,'INDEXF.SYS IS CORRUPT - BAD FILENAME IN EXTENSION HEADER'
        GOTO 125  ! ALREADY REWRITTEN ORIGINAL HEADER - TRY TO GET SOME DATA
      ENDIF
      IF (CHKSUM.NE.0.AND.FILID(1).NE.0) THEN
        TYPE *,'INDEXF.SYS IS CORRUPT - EXTENSION HEADER IS NOT DELETED.'
        GOTO 125  ! ALREADY REWRITTEN ORIGINAL HEADER - TRY TO GET SOME DATA
      ENDIF
      FILID(1)=INFID(1)                              ! PUT IN GOOD FID #
      FILCHR=FILCHR.AND.'FFFF7FFF'X                  ! SAY HEADER IS USED
      CALL CHECKR(RECORD)                            ! CHECKSUM RECORD
      WRITE(1,REC=(FILID(1)+HEADRS-1)) RECORD        ! REWRITE RECORD
      GOTO 120                                       ! LOOK FOR MORE EXT HDRS
 
125   CLOSE(1)   ! PROBABLY DON'T NEED TO HAVE FILE CLOSED BEFORE ANALYZE
                 ! BUT YOU CAN'T EVER BE TO SURE ABOUT THESE THINGS
      TYPE *,' '
      TYPE *,'FILE HEADER IS UPDATED.  BITMAP AND INDEX UPDATE IN PROGRESS.'
      TYPE *,' '
      TYPE *,'PLEASE BE PATIENT, LOTS OF I/O.' 
      DCLCOM='$ ANALYZE/DISK_STRUCTURE/REPAIR '//DEVICE(1:NOSP(DEVICE))
 
! WE HAVE TO DO TWO ANALYZE/DISK_STRUCTURE/REPAIRs.  THE FIRST ONE SEES
! THAT THE FILE HAS NO DIRECTORY.  IT PUTS IT IN [SYSLOST] AND MARKS THE
! BITS AS USED IN THE BITMAP.  IT TAKES CARE OF THE CASE OF MULTIPLY ALLOCATED
! CLUSTERS, DISK QUOTAS AND ALL OTHER PROBLEMS.  THE NEXT TIME IT IS ANALYZEd,
! IT FIXES THE FILES INCORRECT DIRECTORY BACKLINK TO [000000]SYSLOST.DIR
 
      CALL LIB$SET_LOGICAL('SYS$ERROR','NL:')  ! PUT ALL THOSE NASTY ERROR
      CALL LIB$SET_LOGICAL('SYS$OUTPUT','NL:') ! MESSAGES OUT TO THE INFINITE
      CALL LIB$SPAWN(DCLCOM(1:NOSP(DCLCOM)))   ! STORAGE CAPABILITY NULL PORT
      CALL LIB$DELETE_LOGICAL('SYS$OUTPUT')    ! WRITE ONE LINE


      TYPE *,' '
      TYPE *,'CURRENTLY CORRECTING DIRECTORY BACKLINK TO [SYSLOST].'
      CALL LIB$SET_LOGICAL('SYS$OUTPUT','NL:') ! THEN TURN OFF OUTPUT
      CALL LIB$SPAWN(DCLCOM(1:NOSP(DCLCOM)))   ! DO ANALYZE AGAIN
      CALL LIB$DELETE_LOGICAL('SYS$OUTPUT')    ! BRING SYSTEM OUTPUT BACK
      CALL LIB$DELETE_LOGICAL('SYS$ERROR')     ! TO NORMAL AGAIN
     0 DCLCOM='$ DIRECTORY/COLUMNS=1/SIZE=ALL '//DEVICE(1:NOSP(DEVICE))//
     1 '[SYSLOST]'//RECNAM(1:NOSP(RECNAM))
      CALL LIB$SPAWN(DCLCOM(1:NOSP(DCLCOM)))   ! SHOW THAT THE FILE IS THERE
      GOTO 160                                 ! AND THAT'S ALL FOLKS.
 
127   TYPE *,'THERE AREN''T THAT MANY HEADERS.'
      GOTO 150
130   IF (IOST.NE.36) THEN                           ! PRETTY TRICKY, USING
        TYPE *,'ERROR READING INDEXF.SYS'            ! THE SAME 'HEADER REUSED'
        GOTO 150                                     ! LINE FOR ERRORS IN TWO
      ENDIF                                          ! DIFFERENT PLACES.
140   TYPE *,'SORRY, YOUR HEADER HAS BEEN REUSED.'
150   CLOSE(1)
160   END
              
 
! SUBROUTINE GIVEN A FILE ID, WILL GET THE FILE'S FULL DIRECTORY SPECIFICATION
 
      SUBROUTINE FINDIR(RDRFID,HEADRS,DEVICE,RRCNAM,WRCNAM)
      IMPLICIT NONE
 
      BYTE         RECORD(512)
      INTEGER*2    FID(3),RDRFID(3),DRFID(3),BAKFID(3)
      INTEGER*4    HEADRS,NUMDIR,NOSP
      CHARACTER*10 DEVICE,WRCNAM*86,RRCNAM*86,TEMP*135
      EQUIVALENCE  (FID(1),RECORD(9))
      EQUIVALENCE  (BAKFID(1),RECORD(67))
 
      DRFID(1)=RDRFID(1)
      DRFID(2)=RDRFID(2)
      DRFID(3)=RDRFID(3)
      WRCNAM=RRCNAM
 
      TEMP='A'
      NUMDIR=1
     0 OPEN(2,FILE=DEVICE(1:NOSP(DEVICE))//'[000000]INDEXF.SYS',SHARED,READONLY,
     1 FORM='UNFORMATTED',RECORDTYPE='FIXED',STATUS='OLD',ACCESS='DIRECT')
100   READ(2,REC=(DRFID(1)+HEADRS-1)) RECORD                 ! READ THIS RECORD
      TEMP=WRCNAM
      CALL GETNAM(RECORD,WRCNAM)                             ! GET THE FNAM
      IF (NUMDIR.GE.1) THEN                                  !- PATCH THE NAMES
        WRCNAM=WRCNAM(1:INDEX(WRCNAM,'.'))                    ! ALL TOGETHER SO
        IF (NUMDIR.EQ.1) WRCNAM=WRCNAM(1:NOSP(WRCNAM)-1)//']' ! END PRODUCT IS
        NUMDIR=NUMDIR+1                                      !- A FUL DIR SPEC
      ENDIF
      WRCNAM=WRCNAM(1:NOSP(WRCNAM))//TEMP(1:NOSP(TEMP))
      TEMP=' '
      DRFID(1)=BAKFID(1)
      DRFID(2)=BAKFID(2)                ! KEEP ON RECURSIVELY CALLING YOURSELF
      DRFID(3)=BAKFID(3)                ! WITH BACKLINK FILE_IDS TO EACH DIR
      IF (.NOT.(DRFID(1).EQ.4.AND.DRFID(2).EQ.4.AND.DRFID(3).EQ.0)) GOTO 100


      TEMP=WRCNAM                       !^^ IF IT IS THE MFD STOP LOOKING CAUSE
      WRCNAM='[000000.'                 !^^ IT POINTS TOWARDS ITSELF
      IF (NUMDIR.EQ.1) THEN
        WRCNAM=WRCNAM(1:NOSP(WRCNAM)-1)//']'//TEMP(1:NOSP(TEMP))
      ELSE               
        WRCNAM=WRCNAM(1:NOSP(WRCNAM))//TEMP(1:NOSP(TEMP))
      ENDIF
      CLOSE(2)
      RETURN
      END
 
 
! SUBROUTINE THAT GIVEN A HEADER RECORD, WILL EXTRACT THE REDUNDANT FILE NAME
 
      SUBROUTINE GETNAM(RECORD,RECNAM)
      IMPLICIT NONE
 
      BYTE RECORD(512)
      CHARACTER*86 RECNAM
      INTEGER*4 COUNT,IDOFF,MPOFF
 
      IDOFF=RECORD(1)
      IDOFF=IDOFF*2
      MPOFF=RECORD(2)
      MPOFF=MPOFF*2
      IF (IDOFF.LE.0.OR.IDOFF.GT.512) GOTO 100
      DO COUNT=1,20                                     ! GET FIRST PART OF
        RECNAM(COUNT:COUNT)=CHAR(RECORD(IDOFF+COUNT))   ! FILE NAME
        IF (IDOFF+COUNT+1.GT.MPOFF) GOTO 100
      ENDDO
      DO COUNT=21,86                                    ! GET OTHER PART LATER
        RECNAM(COUNT:COUNT)=CHAR(RECORD(IDOFF+COUNT+34))! ON IN IDENT AREA, IF
        IF (IDOFF+COUNT+35.GT.MPOFF) GOTO 100           ! FILENAME NEEDS IT
      ENDDO
100   RETURN
      END
                 
 
! FUNCTION THAT GIVEN A STRING, RETURNS THE NON-SPACE-FILLED LENGTH OF STRING
 
      INTEGER FUNCTION NOSP(STRING)
      IMPLICIT NONE
 
      INTEGER*4 COUNT
      CHARACTER*(*) STRING
 
      DO COUNT=LEN(STRING),1,-1
        IF (STRING(COUNT:COUNT).NE.' ') GOTO 100
      ENDDO
      COUNT=0
100   NOSP=COUNT
      RETURN
      END