SUBROUTINE GETDIR C*********************************************************************** C C Author: Nick Bourgeois Version: 90l04a C 9605 Giddings Ave. NE C Albuquerque, NM 87109 C (505) 828-9566 C C C Description: C C Get a file's directory information. C C Set the byte pointer for starting the directory structure scan. C Go into a loop and call a routine to get the field length. If C an error condition is returned, exit this subroutine. If the C field length is zero, exit the loop. Call a routine to get the C field identification. Call a routine to get the field data. C Call a routine to write the directory data to the output file. C If an error is returned, exit this subroutine. Loop back for C another pass. Finally, write a blank line out to the directory C file. C C If a write error occurs, set the error flag, display an error C message, and exit this subroutine. C C C Edit Record: C C 29-Nov-90: Original creation started. C 04-Dec-90: Original creation completed. C C C Calling sequence: C C ByteBF() = C BytPtr = C OutLun = C CALL GETDIR C C C Returns: C C Error C C C Called By: C C SDWORK C C C Routines Called: C C GETFLD C GETID C GETLEN C WRTDIR C C*********************************************************************** INCLUDE 'SVSTDR.DAT' !Common & variables declarations BytPtr = BytPtr + 18 100 CONTINUE CALL GETLEN IF (Error) GOTO 900 IF (FldLnI .EQ. 0) GOTO 800 CALL GETID CALL GETFLD CALL WRTDIR GOTO 100 800 CONTINUE WRITE (OutLun,*,ERR=850) GOTO 900 850 CONTINUE Error = .TRUE. TYPE *, 'GETDIR: write error' 900 CONTINUE RETURN END !GETDIR.FOR.