.TITLE WILDCARD ;WILDCARD was written July 1, 1981 by A. Sorrell/M.Adkins ; ; This routine accepts a filespec which may contain any legal ;wild card specifier. This routine will then search for all files ;matching the wild specification. It does this using RMS $PARSE and ;RMS $SEARCH. ; ; There are four entry points to this routine, SETWILD, WILDCARD and NEXTWILD, ;and WILDPARSE. ;The default file spec is *.*;* and is what is applied for any "missing" ;fields in the WILDCARD call. If you wish to specify a different default ;spec, call SETWILD before WILDCARD and supply the default specification ;desired. ; ; WILDCARD must be called before NEXTWILD, since it performs the $PARSE ;function and ;buids the FAB, NAMBLK, etc. It will return the first filename ;to match the expanded filespec. Subsequent filenames may be retrieved by ;calling NEXTWILD. ; ; WILDPARSE returns the "pieces" of the file most recently located ;by WILDCARD or NEXTWILD. ; ; Note that all entries return status value as the output of the function ;call. This means that WILDCARD & SETWILD must be typed INTEGER*4. ; ; ISTAT=WILDCARD(WILD_SPEC,FILENAME,LFILENAME [,FID [,DID]]) ; ISTAT=NEXTWILD(WILD_SPEC,FILENAME,LFILENAME [,FID [,DID]]) ; ISTAT=SETWILD(DEF_SPEC) ; ISTAT=WILDPARSE(LEN_NODE_NAME,NODE_NAME, ; LEN_DEV_NAME,DEV_NAME, ; LEN_DIR_NAME,DIR_NAME, ; LEN_FILE_ROOT,FILE_ROOT, ; LEN_FILE_TYPE,FILE_TYPE, ; LEN_FILE_VER,FILE_VER) ; where ; Name TYPE I/O Description ; --------- ---- --- -------------------------------- ; ISTAT I*4 O Status value associated with $SEARCH ; operation. ; WILD_SPEC CHAR I File-spec with embedded wild card ; characters, e.g. *.FOR ; FILENAME CHAR O Filename matching specified wildcard. ; Note that the default specification ; is *.*;* ; LFILENAME I*4 O Number of characters returned in ; FILENAME ; FID I*2 O (Optional 3-word array to hold File ID) ; DID I*2 O (Optional 3-word array to hold Dir ID) ; ; DEF_SPEC CHAR I Default file name spec ; Used to override default *.*;* ; ; LEN_NODE_NAME I*4R O Length of node name ; NODE_NAME CHAR O Node name including access control &(::) ; LEN_DEV_NAME I*4 O Length of DEV_NAME ; DEV_NAME CHAR O Device name including (:) ; LEN_DIR_NAME I*4 O Length of DIR_NAME ; DIR_NAME CHAR O Directory list descriptor including ([]) ; LEN_FILE_ROOT I*4 O Length of FILE_ROOT ; FILE_ROOT CHAR O File name ; LEN_FILE_TYPE I*4 O Length of FILE_TYPE ; FILE_TYPE CHAR O File type incl period (.) ; LEN_FILE_VER I*4 O Length of FILE_VER ; FILE_VER CHAR O Version number incl (;) ; ; Note that FID and DID are optional. However, if you want ; DID, you MUST also supply FID. ; ;STATUS VALUES RETURNED: ; 1. RMS$_NORMAL Normal completion ; 2. RMS$_NMF No more files found in specified directory ; 3. RMS$_FNF No match for specified wild card ; 4. Miscellaneous other status values are also possible. ; ;The FAB block is accessible through PSECT WILDFAB (Length=80 bytes) ; NAM block is accessible through PSECT WILDNAM (Length=56 bytes) ; ;The device name is available by using the following construct: ; CHARACTER*16 DEVICE_NAME ; BYTE NAMBLK,DEVLEN ; COMMON/WILDNAM/NAMBLK(56) ; EQUIVALENCE(NAMBLK(22),DEVICE_NAME),(DEVLEN,NAMBLK(21)) ; It MUST be referenced using the device length specifier, i.e., ; DEVICE_NAME(1:DEVLEN) ;*************************************************************************** ; EXAMPLE: ;*************************************************************************** ; The FORTRAN fragment below shows how one might use this routine, testing ;for status= RMS$_NMF (no more files) to determine when there are no ;more matches for the input specification. ; INTEGER*4 RMS$_NORMAL,RMS$_NMF,WILDCARD ; EXTERNAL RMS$_NORMAL,RMS$_NMF,RMS$_FNF ; COMMON/WILDFAB/FAB ; COMMON/WILDNAM/NAM ; BYTE FAB(80),NAM(56) ; CHARACTER*132 WILD_SPEC,FILENAME ; INTEGER*2 FID(3),DID(3) ; ........ ; 10 get WILD_SPEC as desired ; ........ ; ISTAT=WILDCARD(WILD_SPEC,FILENAME,LFILENAME) ; DO WHILE(ISTAT.EQ.%LOC(RMS$_NORMAL)) ; TYPE 1002, FILENAME(1:LFILENAME) ; 1002 FORMAT(1X,A) ; ISTAT=NEXTWILD(WILD_SPEC,FILENAME,LFILENAME,FID,DID) ; ENDDO ; IF(ISTAT.EQ.%LOC(RMS$_NMF)) GO TO 10 ; IF(ISTAT.EQ.%LOC(RMS$_FNF)) THEN ; TYPE *,'FILE NOT FOUND' ; GO TO 10 ; ENDIF ; CALL EXIT(ISTAT) ; 100 END ; ; ;*************************************************************************** ; .PSECT WILDNAM,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,LONG NAMBLK: $NAM ESA=ESABUF,ESS=255,- ;Expanded name area & length RSA=RSABUF,RSS=255 ;Resultant name area & length .PSECT WILDFAB,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,LONG FABBLK: $FAB NAM=NAMBLK,DNM=<*.*;*> .PSECT WILDCARD,NOPIC,CON,REL,LCL,NOSHR,EXE,RD,WRT $RMSDEF WILD_SPEC=4 DEF_SPEC=4 FILENAME=8 LFILENAME=12 FIDARG=16 ;Optional 3-word array DIDARG=20 ;Optional 3-word array ESABUF: .BLKB 255 RSABUF: .BLKB 255 .ENTRY SETWILD,^M<> MOVQ @DEF_SPEC(AP),R0 ;Get filename descriptor MOVB R0,FABBLK+FAB$B_DNS ;Save it MOVL R1,FABBLK+FAB$L_DNA ;Save file name address MOVL #RMS$_NORMAL,R0 RET .ENTRY WILDCARD,^M MOVQ @WILD_SPEC(AP),R0 ;Get filename descriptor MOVB R0,FABBLK+FAB$B_FNS ;Save it MOVL R1,FABBLK+FAB$L_FNA ;Save file name address ; ; Perform the $PARSE to expand the filename ; $PARSE FAB=FABBLK ;This fills in ESABUF,SSS,ESL BRB SEARCH ;Skip over entry mask .ENTRY NEXTWILD,^M ; ; Next search for someone matching the expanded filename ; SEARCH: $SEARCH FAB=FABBLK ;This fills in RSABUF,RSS,RSL ;RSABUF has full filename now BLBC R0,RETN ;Skip if error PUSHR #^M ;Save R0 status register MOVZBL NAMBLK+NAM$B_RSL,@LFILENAME(AP) ;Store length of filename MOVZBW NAMBLK+NAM$B_RSL,R3 ;Put length of FILENAME in R3 MOVQ @FILENAME(AP),R0 ;Get address of FILENAME MOVC3 R3,RSABUF,(R1) ;Move name to FILENAME L1: CASEL (AP),#3,#2 ;3, 4, or 5 arguments CTABLE: .WORD RETS-CTABLE ;If 3 args, don't store FID/DID .WORD L4-CTABLE ;If 4 args, store FID .WORD L5-CTABLE ;If 5 args, store FID and DID BRB RETS ;Out of range L5: MOVC3 #6,NAMBLK+NAM$W_DID,@DIDARG(AP) ;Copy DID to arg 5 L4: MOVC3 #6,NAMBLK+NAM$W_FID,@FIDARG(AP) ;Copy FID to arg 4 RETS: POPR #^M ;Restore status from $SEARCH RETN: RET ;Home, James! LEN_NODE_NAME =4 NODE_NAME =8 LEN_DEV_NAME =12 DEV_NAME =16 LEN_DIR_NAME =20 DIR_NAME =24 LEN_FILE_ROOT =28 FILE_ROOT =32 LEN_FILE_TYPE =36 FILE_TYPE =40 LEN_FILE_VER =44 FILE_VER =48 .ENTRY WILDPARSE,^M MOVZBL NAMBLK+NAM$B_NODE,@LEN_NODE_NAME(AP) MOVZBL NAMBLK+NAM$B_NODE,R3 MOVQ @NODE_NAME(AP),R0 MOVL NAMBLK+NAM$L_NODE,R4 MOVC5 R3,(R4),#32,R0,(R1) MOVZBL NAMBLK+NAM$B_DEV,@LEN_DEV_NAME(AP) MOVZBL NAMBLK+NAM$B_DEV,R3 MOVQ @DEV_NAME(AP),R0 MOVL NAMBLK+NAM$L_DEV,R4 MOVC5 R3,(R4),#32,R0,(R1) MOVZBL NAMBLK+NAM$B_DIR,@LEN_DIR_NAME(AP) MOVZBL NAMBLK+NAM$B_DIR,R3 MOVQ @DIR_NAME(AP),R0 MOVL NAMBLK+NAM$L_DIR,R4 MOVC5 R3,(R4),#32,R0,(R1) MOVZBL NAMBLK+NAM$B_NAME,@LEN_FILE_ROOT(AP) MOVZBL NAMBLK+NAM$B_NAME,R3 MOVQ @FILE_ROOT(AP),R0 MOVL NAMBLK+NAM$L_NAME,R4 MOVC5 R3,(R4),#32,R0,(R1) MOVZBL NAMBLK+NAM$B_TYPE,@LEN_FILE_TYPE(AP) MOVZBL NAMBLK+NAM$B_TYPE,R3 MOVQ @FILE_TYPE(AP),R0 MOVL NAMBLK+NAM$L_TYPE,R4 MOVC5 R3,(R4),#32,R0,(R1) MOVZBL NAMBLK+NAM$B_VER,@LEN_FILE_VER(AP) MOVZBL NAMBLK+NAM$B_VER,R3 MOVQ @FILE_VER(AP),R0 MOVL NAMBLK+NAM$L_VER,R4 MOVC5 R3,(R4),#32,R0,(R1) MOVL #SS$_NORMAL,R0 RET .END