C PROGRAM TO SEARCH A DEVICE DIRECTORY FOR A REQUESTED FILENAME AND RETURN ITS C NAME, # OF BLOCKS, DATE AND DEVICE WHERE DIRECTORY ENTRY WAS FOUND. THEN C THE DEVICE IS SCANNED FOR '*.DEV' FILES (SUBDEVICES) AND THEIR INDIVIDUAL C DIRECTORIES ARE SCANNED FOR FILENAME. C C THIS PROGRAM ALLOWS A LARGE DISK VOLUME CONTAINING SEVERAL SUBDEVICES TO C SCANNED FOR A FILENAME. THE PROGRAM RETURNS THE USUAL DIRECTORY C INFORMATION PLUS WHAT DEVICE OR SUBDEVICE THE FILE WAS FOUND ON. C C FILED BY GLENN BEVER--14-FEB-83. (HAPPY VALENTINE'S DAY!) C WILD CARD SEARCHES IMPROVED--5-APR-83, G. BEVER. C '/V' OPTION ADDED--8-APR-83, G. BEVER. C 'E:EXT' OPTION ADDED--9-JUL-84, G. BEVER. C SYSTEM IDENTIFICATION CHECK ADDED--31-0CT-84, G. BEVER. C RTDIR SUBROUTINE REMOVED AND MADE ANOTHER MODULE--8-MAR-85, G. BEVER. C CHECK FOR FILE < 6 BLKS LONG MOVED TO PREVENT 'HANG'--19-APR-85, G. BEVER. C ADD DATE OPTION--22-APR-85, G. BEVER. C ADD TSX+ TIME OPTION--3-JAN-86, G. BEVER. C ADD 'N:EXT' OPTION--27-FEB-86, G. BEVER. C C NASA DFRF C P.O. BOX 273 C EDWARDS, CA 93523 C C COMPILE AS FOLLOWS: C C .FORTRA SDIR C C LINK AS FOLLOWS: C C .LINK SDIR,RTDIR,NAMCMP C C REQUIRES LINKAGE WITH 'IRAM.OBJ' IF IT HAS NOT BEEN PUT IN 'SYSLIB.OBJ'. C C C CALL COMMAND STRING INTERPRETER TO GET DEVICE NAMES. C *TT:=DEV:FILE.NAM C C WHERE 'FILE.NAM' IS THE FILE TO SEARCH THE DIRECTORY FOR. C AND 'DEV:' IS THE DISK CONTAINING THE DIRECTORY TO SCAN C FOR 'FILE.NAM' AND SUBDIRECTORIES '*.DEV' TO SCAN FOR 'FILE.NAM'. C C */H C WILL PRINT OUT HELP FOR USING THIS PROGRAM. C C *DEV:FILE.NAM C WILL DEFAULT LIST TO LOGICAL UNIT 7 (TT:). C C*******KNOWN BUGS (IN PROGRAM)********** C 1) BOTH NAME AND EXTENT FIELD MUST HAVE THEIR OWN WILDCARD. C E.G.: C *.* * C WIL*.* INSTEAD OF WIL* C *.*D *D C C*******KNOWN BUGS (IN SUBROUTINE NAMCMP)********** C 1) REPEATED CHARACTER STRING COMPARE PROBLEM. E.G.: C IF '*FER.*' IS ENTERED AND 'BUFFER.COM' IS ENCOUNTERED, IT WILL NOT C REPORT IT AS A MATCH. THE ALGORITHM STARTS COMPARING CHARACTER C STRING 'FER' WITH THE 1ST 'F' IN 'BUFFER', HENCE, IT SEES 'FFE' C AND NOT 'FER'. C C 2) IF 5 CHARACTERS ARE ENTERED AND THE 6TH IS '*', NO MATCH WILL BE C REPORTED. E.G.: C 'BUFFE*.COM' REQUESTED WILL NOT FIND 'BUFFER.COM'. C C************************************************** C BUG SUMMARY: ALL PERMUTATIONS OF WILDCARD COMPARES DON'T WORK. C************************************************** C INTEGER*2 JNUM(2) INTEGER*2 ISPEC(39),JSWI(4,14) INTEGER*2 IVOL(6),IOWN(6),IDUM(6),JDAT(3) REAL*4 EXT(2) INTEGER*2 PASSIN(3),PASOUT(5),IBUF(512),IBUF1(512),IN(3), C DEVICE(6) BYTE NAMDEV(12),NAME(9) DATA EXT/6RDEVLST,6RDATDAT/ DATA JSWI/'H',3*0,'V',3*0,'E',3*0,'A',3*0, . 'D',3*0,'D',3*0,'D',3*0,'S',3*0,'S',3*0,'S',3*0, . 'B',3*0,'B',3*0,'B',3*0,'N',3*0/,IDIF/0/ C NOTE: 'A' & 'S' CURRENTLY UNUSED. INUM=0 C CALL COMMAND STRING INTERPRETER TO GET FILE NAMES. 5 IF(ICSI(ISPEC,EXT,,JSWI,14).NE.0) GO TO 5 C ASSIGN LOGICAL UNIT 7 TO 1ST OUTPUT FILE ENTERED. CALL IASIGN(7,ISPEC(1),ISPEC(2),0,0) C IF '/H' SWITCH NOT HIT, GO TO 6. IF(JSWI(2,1).EQ.0) GO TO 9 C HELP OUTPUT. WRITE(7,105) 105 FORMAT(' */H PRINTS THIS TEXT.'/ C ' *LP:=DEV:FILE.NAM SEARCHES "DEV:" & ALL SUBDEVICES'/ C ' ON IT FOR "FILE.NAM."'/ C ' PRINTS ON LP:'/ C ' *FILE.* SEARCHES FOR "FILE.*". PRINTS ON TT:.'/ C ' *TT:=*.NAM SEARCHES FOR "*.NAM". PRINTS ON TT:.'/ C ' .RU SDIR *.NAM SEARCHES FOR "*.NAM" FILES.'/ C ' PRINTS ON TT:.'/ C ' .RU SDIR *.NAM LP: SEARCHES FOR "*.NAM" FILES.'/ C ' PRINTS ON LP:.'/ C ' .RU SDIR DEV:/V PRINTS OUT VOLUME IDs FOR ALL'/ C ' SUBDEVICES ON "DEV:"'/ C ' .RU SDIR SEARCHES "DEV:" & "DEV:*.DSK" '/ C ' *DEV:FILE.NAM/E:DSK SUBDEVICES FOR "FILE.NAM."'/ C ' .SDIR DEV:FILE.NAM SEARCHES "DEV:" & ALL SUBDEVICES'/ C ' ENCOUNTERED ON IT FOR "FILE.NAM"'/ C ' (RT-11 V5 OR LATER ONLY)') WRITE(7,101) 101 FORMAT(' .SDIR *.*/D:22.:APR:85. SEARCHES "DEV:" & ALL SUBDEVICES' C /,' FOR ALL FILES ON SPECIFIED DATE'/ C ' .SDIR *.*/S:22.:APR:85. SEARCHES "DEV:" & ALL SUBDEVICES'/ C ' FOR ALL FILES ON OR AFTER DATE'/ C ' .SDIR *.*/B:22.:APR:85. SEARCHES "DEV:" & ALL SUBDEVICES'/ C ' FOR ALL FILES ON OR BEFORE DATE'/ C ' .SDIR *.*/N:BAD SEARCHES "DK:" & ALL SUBDEVICES'/ C ' EXCEPT "*.BAD" FOR FILES'/) GO TO 5 ! CALL COMMAND STRING INTERPRETER AGAIN. C 9 I=0 ! INIT BASE. IF(JSWI(2,11).EQ.2) I=11! IF 'B' OPTION ENTERED, ASSIGN BASE. IF(JSWI(2,8).EQ.2) I=8 ! IF 'S' OPTION ENTERED, ASSIGN BASE. IF(JSWI(2,5).EQ.2) I=5 ! IF 'D' OPTION ENTERED, ASSIGN BASE. C IF(I.EQ.0) GO TO 11 ! IF NOT 'D' OR 'S' OPTION, GO TO 11. C JDAT(3)=JSWI(4,I) ! ASSIGN JDAT THE DATE ENTERED ON '/D' SWITCH. JDAT(2)=JSWI(4,I+1) JDAT(1)=JSWI(4,I+2) C JDATE=INTDAT(JDAT)! CALL ROUTINE TO CONVERT SWITCH DATE TO INTERNAL DATE. C C GET FILE NAME TO SEARCH FOR. 11 PASSIN(1)=ISPEC(17) PASSIN(2)=ISPEC(18) PASSIN(3)=ISPEC(19) C NULL OUT FILE NAME SO AS TO OPEN THE DEVICE NON-STRUCTURED. ISPEC(17)="000000 ISPEC(18)="000000 ISPEC(19)="000000 C SET 'IBK' TO INDICATE 1ST CALL TO 'RTDIR'. IBK=0 C SET TO SEARCH DEVICE. DEVICE(1)=ISPEC(16) C SEARCH DEVICE 1ST (BEFORE SEARCHING SUBDEVICES). DEVICE(2)="000000 DEVICE(3)="000000 DEVICE(4)="000000 C C CONVERT FOUND DEVICE FILE NAME TO ASCII. CALL R50ASC(12,DEVICE,NAMDEV) C GO TO 8 C ASSIGN '*.DEV' TO FILE NAME REQUEST. 7 IN(1)="132500 IN(2)="000000 IN(3)="132500 IF(JSWI(2,3).EQ.2) IN(3)=JSWI(4,3)! IF /E OPTION, ASSIGN IT TO IN(3). C CALL ROUTINE TO FIND DIRECTORY ENTRY '*.DEV', '*.*' (/A) OR '*.xxx' (/E:xxx). CALL RTDIR(ISPEC(16),IN,DEVICE(2),MORE,IBK,IND,IBUF1,ICH, C IVOL,IOWN) C IF FILE NOT FOUND, GO TO 20. IF(MORE.EQ.0) GO TO 20 IF(DEVICE(5).LT.6) GO TO 7 ! IF FILE < 6 BLKS, CAN'T BE SUBDEVICE. C IF NOT RT-11 VOLUME, IGNORE. IF(MORE.EQ.-1) GO TO 7 C IF '/N:ext' SELECTED, AND '*.ext' IS FOUND, SKIP IT. IF(JSWI(2,14).EQ.2.AND.DEVICE(4).EQ.JSWI(4,14)) GO TO 7 C CONVERT FOUND DEVICE FILE NAME TO ASCII. CALL R50ASC(12,DEVICE,NAMDEV) C C CHECK FOR '/V' OPTION. IF(JSWI(2,2).EQ.0) GO TO 8 ! IF NO /V OPTION, GO TO 8. C GET VOLID ONLY. IBLK=0 CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN, C IVOL,IOWN) C IF(MORE.EQ.-1) GO TO 7 ! IF NOT RT-11 VOLUME, DON'T PRINT. WRITE(7,106)(NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 106 FORMAT(1X,3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) GO TO 7 ! GET NEXT '*.DEV' FILE. C C SET 'IBLK' TO INDICATE 1ST CALL TO 'RTDIR'. 8 IBLK=0 C CALL ROUTINE TO FIND DIRECTORY ENTRY OF FILE.NAM. 10 CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN, C IVOL,IOWN) C IF FILE NOT FOUND, GO TO 7. IF(MORE.LE.0) GO TO 7 C CONVERT DATE. I=IDATE(PASOUT(5),IDAY,RMON,IYR,JDATE) C CONVERT TIME. I1=ITIM(PASOUT(6),IHR,MIN,ISEC) IF(JSWI(2,5).NE.2) GO TO 12 ! IF 'D' OPTION NOT ENTERED, GO TO 12. IF(I.NE.0) GO TO 10 ! IF NO DATE COMPARE, GO TO 10. GO TO 14 12 IF(JSWI(2,8).NE.2) GO TO 13 ! IF 'S' OPTION NOT ENTERED, GO TO 13. IF(I.NE.0.AND.I.NE.1) GO TO 10 ! IF NOT ON OR AFTER DATE, GO TO 10. GO TO 14 13 IF(JSWI(2,11).NE.2) GO TO 14 ! IF 'B' OPTION NOT ENTERED, GO TO 14. IF(I.NE.0.AND.I.NE.-1) GO TO 10 ! IF NOT ON OR BEFORE DATE, GO TO 10. C C CONVERT FILE NAME FROM RAD50 TO ASCII. 14 CALL R50ASC(10,PASOUT,NAME) C IF FILE DIRECTORY ENTRY HAD NO DATE, GO TO 19. IF(IDAY.EQ.0.AND.IYR.EQ.0) GO TO 19 C IF FILE DIRECTORY ENTRY HAD NO TIME, GO TO 21. IF(I1.EQ.-1) GO TO 21 C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7. WRITE(7,103)(NAME(I),I=1,9),PASOUT(4),IDAY,RMON,IYR,IHR,MIN,ISEC, C (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 103 FORMAT(1X,6A1,'.',3A1,I6,2X,I2,'-',A3,'-',I2,1X,I2,':',I2,':',I2, C 1X,3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) C LOOK FOR MORE IN FILE. GO TO 10 C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7 (NO DATE). 19 WRITE(7,104)(NAME(I),I=1,9),PASOUT(4), C (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 104 FORMAT(1X,6A1,'.',3A1,I6,2X,9X,10X, C 3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) C LOOK FOR MORE IN FILE. GO TO 10 C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7 (DATE, BUT NO TIME). 21 WRITE(7,107)(NAME(I),I=1,9),PASOUT(4),IDAY,RMON,IYR, C (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6) 107 FORMAT(1X,6A1,'.',3A1,I6,2X,I2,'-',A3,'-',I2,1X,8X, C 1X,3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2) C LOOK FOR MORE IN FILE. GO TO 10 C GET NEXT COMMAND. 20 TYPE 110 ! PRINT CR,LF. 110 FORMAT(1X,/) REWIND 7 ! CLEAR OUTPUT BUFFER. CALL CLOSE(7) ! RELEASE LU 7 DEFINITION. GO TO 5 END FUNCTION IDATE(IDAT,IDAY,RMON,IYR,JDATE) C SUBROUTINE TO CONVERT RT-11 INTERNAL DATE FORMAT TO 'DA-MON-YR' FORMAT. C CALL AS: C C IRET=IDATE(IDAT,IDAY,RMON,IYR,JDATE) C WHERE: C I IDAT= INTERNAL FORMATTED DATE. C O IDAY= INTEGER DAY (0-31). C O RMON= (REAL) ASCII MONTH ('Jan'-'Dec' or ' ') C O IYR= INTEGER YEAR (0-99). C I JDATE= INTERNAL FORMATTED DATE TO COMPARE WITH. C C RETURNS: C O IRET= -1 -> FILE DATE IS BEFORE SPECIFIED FILE DATE. C 0 -> FILE DATE IS SAME AS SPECIFIED FILE DATE. C 1 -> FILE DATE IS AFTER SPECIFIED FILE DATE. C C I-> INPUT TO SUBROUTINE. O-> OUTPUT (RETURNED) FROM SUBROUTINE. C REAL*4 TABLE(13),RMON DATA TABLE/'Jan ','Feb ','Mar ','Apr ','May ','Jun ','Jul','Aug ', C 'Sep ','Oct ','Nov ','Dec ',' '/ IF(IDAT.NE.0) GO TO 10 C NO DATE FOUND (IDAT=0). IDAY=0 ! SET DAY TO 00. RMON=TABLE(13) ! SET MONTH TO ' '. IYR=0 ! SET YEAR TO 00. RETURN C DATE FOUND. 10 MON=IRAM(IDAT,10,"17) ! GET MONTH TABLE INDEX. RMON=TABLE(MON) ! RE-FORMAT MONTH. IDAY=IRAM(IDAT,5,"37) ! RE-FORMAT DAY. IYR=IRAM(IDAT,0,"37)+72 ! RE-FORMAT YEAR. C IDATE=0 ! DATE MATCHES. IF(IDAT.EQ.JDATE) IDATE=0 ! DATE MATCHES. C MAKE INTERNAL DATE YR.MON.DA FOR COMPARISON. IDAT1=IRAM(IDAT,-10,"76000) IDAT1=IOR(IDAT1,IRAM(IDAT,4,"001700)) IDAT1=IOR(IDAT1,IRAM(IDAT,5,"37)) C C MAKE INTERNAL DATE YR.MON.DA FOR COMPARISON. JDATE1=IRAM(JDATE,-10,"76000) JDATE1=IOR(JDATE1,IRAM(JDATE,4,"001700)) JDATE1=IOR(JDATE1,IRAM(JDATE,5,"37)) C IF(IDAT1.LT.JDATE1) IDATE=-1 ! DATE IS BEFORE COMPARISON DATE. IF(IDAT1.GT.JDATE1) IDATE=1 ! DATE IS AFTER COMPARISON DATE. RETURN END FUNCTION INTDAT(JDAT) C FUNCTION TO CONVERT ICSI SWITCH ENTERED DATE TO INTERNAL FORMAT. C WHERE: C I JDAT= 3 WORD ARRAY (DAY,MON,YR) DATE TO CONVERT TO INTERNAL C FORMAT, WHERE: C DAY= INTEGER FOR DAY. C MON= RAD50 FOR MONTH (3 LETTERS). C YR= LAST 2 DIGITS INTEGER FOR YEAR. C O INTDAT= RETURNED INTERNALLY FORMATTED DATE. C INTEGER*2 JDAT(3),MONTH(12) DATA MONTH/3RJAN, 3RFEB, 3RMAR, 3RAPR, 3RMAY, 3RJUN, 3RJUL, 3RAUG, . 3RSEP, 3ROCT, 3RNOV, 3RDEC/ C CONVERT JDAT TO INTERNAL FORMAT. JDATE=IRAM(JDAT(1),-5,"1740) !DAY JDATE=IOR(JDATE,IAND(JDAT(3)-72,"37)) !YEAR. DO 15 I=1,12 IF(JDAT(2).EQ.MONTH(I)) GO TO 20 ! IF YEAR FOUND IN TABLE, GO TO 20. 15 CONTINUE STOP 'MONTH NOT FOUND' 20 INTDAT=IOR(JDATE,IRAM(I,-10,"36000)) !MONTH. RETURN END FUNCTION ITIM(ITIME,IHR,MIN,ISEC) C SUBROUTINE TO CONVERT TSX+ INTERNAL TIME FORMAT TO 'HR:MN:SC' FORMAT. C CALL AS: C C IRET=ITIM(ITIME,IHR,MIN,ISEC) C WHERE: C I ITIME= INTERNAL FORMATTED TIME. C O IHR= INTEGER HOUR (0-23). C O MIN= INTEGER MINUTES (0-59). C O ISEC= INTEGER SECONDS (0-59). C C RETURNS: C O IRET= -1 -> NO TIME. C 0 -> FILE TIME IS FOUND. C C I-> INPUT TO SUBROUTINE. O-> OUTPUT (RETURNED) FROM SUBROUTINE. C TIM=ITIME*3. ! NORMALIZE TO SECONDS. IHR=TIM/3600. ! EXTRACT HOURS. MIN=TIM/60.-IHR*60 ! EXTRACT MINUTES. ISEC=TIM-IHR*3600.-MIN*60 ! EXTRACT SECONDS. C ITIM=0 ! DEFAULT TIME TO 'FOUND'. IF(TIM.EQ.0) ITIM=-1 ! NO TIME FOUND. RETURN END