.TITLE FPARSE .IDENT /01-000/ ;++ ; ; Facility: FPARSE ; ; Author: Hunter Goatley, goathunter@WKUVX1.BITNET ; ; Date: December 20, 1992 ; ; Functional Description: ; ; Provide easy access to the $PARSE RMS routine. This routine is ; based on DCL's F$PARSE routine. It does a syntax-only parse on ; the name (the existence of the directory is not checked). ; ; Modified by: ; ; 01-000 Hunter Goatley 20-DEC-1992 15:55 ; Original version. ; ;------------------------------------------------------------------------------- ; ; Inputs: ; ; 4(AP) - Descriptor for buffer to receive information ; 8(AP) - Descriptor for file specification to be parsed ; 12(AP) - Descriptor for default file specification (default is ; SYS$DISK:[].;) ; 16(AP) - Address of bit mask describing information to be returned ; (Default is NODE::DEVICE:[DIRECTORY]NAME.TYPE;VERSION) ; ; Bit 5 set - return node name (usually null) ; Bit 4 set - return device name ; Bit 3 set - return directory name ; Bit 2 set - return file name ; Bit 1 set - return file type name ; Bit 0 set - return version number ; ; Output: ; ; 4(AP) - Descriptor for parsed file specification ; ; Returns: ; ; Status value in R0 ; ; Calling sequence: ; ; status = fparse (&result, &filename, &default, &bitmask); ; ;-- RESULT = 1 * 4 ; Descriptor for resultant name FILE = 2 * 4 ; File specification DEFAULT = 3 * 4 ; Default file spec OPTIONS = 4 * 4 ; Bit mask for return info NUMARGS = 4 FP_V_NODE = 5 ; Bit 5 = node name (usually "") FP_V_DEV = 4 ; Bit 4 = device name FP_V_DIR = 3 ; Bit 3 = directory name FP_V_NAME = 2 ; Bit 2 = file name FP_V_TYPE = 1 ; Bit 1 = file type FP_V_VER = 0 ; Bit 0 = version number $SSDEF ; System service status symbols $LIBDEF ; LIB$ error symbols $RMSDEF ; RMS definitions $FABDEF ; File Access Block symbols $RABDEF ; Record Access Block symbols $NAMDEF ; Name block symbols .PSECT _FPARSE_DATA,NOEXE,WRT,LONG,SHR ; ;*** File Access Block for input ; PARSE_FAB: $FAB FOP=NAM, - ; Options: NAM block NAM=PARSE_NAM ; NAM block address PARSE_NAM: $NAM ESA=PARSE_RESULT, - ; Resultant string address ESS=NAM$C_MAXRSS ; Buffer size PARSE_RESULT: .BLKB NAM$C_MAXRSS ; Buffer for resultant name .ALIGN LONG WORK_BUFFER: .BLKB NAM$C_MAXRSS ; Work buffer for final string .ALIGN LONG DEFAULT_SPEC: .ASCII /SYS$DISK:[].;/ ; Default default file DEFAULT_SPEC_L = . - DEFAULT_SPEC ; ... specification and length .PSECT _FPARSE_CODE,EXE,NOWRT,LONG,PIC,SHR .ENTRY FPARSE,^M CMPW #NUMARGS,(AP) ; Were X arguments given? BEQLU 10$ ; Branch if yes - we're OK MOVL #LIB$_WRONUMARG,R0 ; Return error code RET ; Return to caller 10$: MOVAL PARSE_FAB,R6 ; Point R3 to FAB MOVAL PARSE_NAM,R7 ; Point R4 to resultant NAM ; ; Initialize structures ; CLRB FAB$B_FNS(R6) ; Clear file spec size CLRL FAB$L_FNA(R6) ; Clear file spec address MOVB #DEFAULT_SPEC_L,FAB$B_DNS(R6) ; Set default file spec size MOVAB DEFAULT_SPEC,FAB$L_DNA(R6) ; Set default file spec addr MOVL DEFAULT(AP),R0 ; Get related file spec address BEQLU 20$ ; Branch if not given JSB G^LIB$ANALYZE_SDESC_R2 ; Analyze for length and address MOVB R1,FAB$B_DNS(R6) ; Move length to FAB MOVL R2,FAB$L_DNA(R6) ; ... 20$: MOVL FILE(AP),R0 ; Get file spec address BEQLU 30$ ; Branch if not given JSB G^LIB$ANALYZE_SDESC_R2 ; Analyze for length and address MOVB R1,FAB$B_FNS(R6) ; Move length to FAB MOVL R2,FAB$L_FNA(R6) ; ... 30$: $PARSE FAB=(R6) ; Go parse it BLBS R0,40$ ; Branch if successful BRW 130$ ; Branch to return on error 40$: MOVL OPTIONS(AP),R9 ; Get options address BEQLU 50$ ; Branch if not given MOVL (R9),R9 ; Get the options BRB 60$ ; Skip over default options 50$: MOVZBL #^XFF,R9 ; Set all options 60$: MOVAL WORK_BUFFER,R3 ; Get address of work buffer ; BBC #FP_V_NODE,R9,70$ ; Branch if node is not returned MOVZBL NAM$B_NODE(R7),R0 ; Get length of node name MOVC3 R0,@NAM$L_NODE(R7),(R3) ; Copy node to work buffer ; 70$: BBC #FP_V_DEV,R9,80$ ; Branch if dev is not returned MOVZBL NAM$B_DEV(R7),R0 ; Get length of device name MOVC3 R0,@NAM$L_DEV(R7),(R3) ; Copy device to work buffer ; 80$: BBC #FP_V_DIR,R9,90$ ; Branch if dir is not returned MOVZBL NAM$B_DIR(R7),R0 ; Get length of directory spec MOVC3 R0,@NAM$L_DIR(R7),(R3) ; Copy directory to work buffer ; 90$: BBC #FP_V_NAME,R9,100$ ; Branch if name is not returned MOVZBL NAM$B_NAME(R7),R0 ; Get length of filename MOVC3 R0,@NAM$L_NAME(R7),(R3) ; Copy name to work buffer ; 100$: BBC #FP_V_TYPE,R9,110$ ; Branch if type is not returned MOVZBL NAM$B_TYPE(R7),R0 ; Get length of type MOVC3 R0,@NAM$L_TYPE(R7),(R3) ; Copy type to work buffer ; 110$: BBC #FP_V_VER,R9,120$ ; Branch if ver is not returned MOVZBL NAM$B_VER(R7),R0 ; Get length of version MOVC3 R0,@NAM$L_VER(R7),(R3) ; Copy version to work buffer ; 120$: MOVAL WORK_BUFFER,R0 ; Get address of work buffer PUSHL R0 ; Build descriptor for it SUBL3 R0,R3,-(SP) ; Get length on stack PUSHAL (SP) ; Copy work buffer to user's PUSHAQ @RESULT(AP) ; ... result buffer CALLS #2,G^STR$COPY_DX ; ... 130$: RET ; Return to caller .END .TITLE WHO .IDENT /01-000/ ;++ ; ; Program: WHO.MAR ; ; Author: Hunter Goatley, goathunter@WKUVX1.BITNET ; ; Date: December 20, 1992 ; ; Abstract: Sample program to read a record from SYSUAF. ; ; Modified by: ; ; 01-000 Hunter Goatley 20-DEC-1992 14:32 ; ;-- .LIBRARY /SYS$LIBRARY:LIB.MLB/ ; For $UAFDEF $UAFDEF ; Include SYSUAF symbols ; ; Define a macro to check for errors. ; .MACRO ON_ERR DEST,?HERE BLBS R0,HERE BRW DEST HERE: .ENDM ON_ERR ; ; The data psect ; .PSECT WHO_DATA,NOEXE,WRT,LONG ; ; The FAB for the SYSUAF file. Note that SHR is given so we don't lock ; others out of the SYSUAF file while we have it open!! ; SYSFAB: $FAB FNM=, - ; The file name FAC=GET, - ; Want to GET from it SHR= ; Allow other access ; ; The RAB to read a record based on the username key. ; SYSRAB: $RAB FAB=SYSFAB, - ; The File Access Block RAC=KEY, - ; Record ACcess is keyed KRF=0, - ; Key of ReFerence = position 0 KSZ=12, - ; The default Key SiZe KBF=FOR_BUFF, - ; Key is found in FOR_BUFF USZ=UAF$K_LENGTH, - ; Buffer is 1420 chars long UBF=SYSREC ; Addr of SYSUAF record buffer ; SYSREC: .BLKB UAF$K_LENGTH ; FAO_STR: .ASCID /Username: !AD Owner: !AC/ .ALIGN LONG FAO_OUT_D: .WORD 256 ; Descriptor for $FAO output .BYTE DSC$K_DTYPE_T ; ... buffer .BYTE DSC$K_CLASS_S ; ... .ADDRESS .+4 ; ... .BLKB 256 ; ... FOR_BUFF_D: .WORD 256 ; LIB$GET_FOREIGN buffer .BYTE DSC$K_DTYPE_T ; ... descriptor .BYTE DSC$K_CLASS_S ; ... .ADDRESS FOR_BUFF ; ... FOR_BUFF: .BLKB 256 PROMPT_D: .ASCID /Username: / .ALIGN LONG MSG1: .ASCID /Username not found./ .ALIGN LONG GET_FOREIGN_ARGLST: .LONG 3 ; 3 parameters .ADDRESS FOR_BUFF_D ; Input buffer .ADDRESS PROMPT_D ; Prompt descriptor address .ADDRESS FOR_BUFF_D ; Length of username given ;=============================================================================== ; .PSECT WHO,EXE,NOWRT,LONG .ENTRY WHO,^M<> ; ; Get the username from the command line, prompting the user if it's absent. ; CALLG GET_FOREIGN_ARGLST,- ; Get the username off the G^LIB$GET_FOREIGN ; ... command line ; MOVZWL FOR_BUFF_D,R1 ; Get its length BNEQU 10$ ; Branch if something given BRW 40$ ; Exit if nothing or error ; ; Use the length of the username given as the size of the key for the $GET. ; Note that a better way to do this would be to blank-pad the key to the ; size of the SYSUAF key (UAF$S_USERNAME), but using the size specified ; will cause RMS to retrieve the first record that matches the partial ; username. ; 10$: MOVB R1,SYSRAB+RAB$B_KSZ ; Set the key size in the RAB $OPEN FAB=SYSFAB ; Open the SYSUAF file ON_ERR 40$ ; Branch on error $CONNECT - ; Connect the RAB RAB=SYSRAB ; ... ON_ERR 20$ ; Branch on any error ; ; Now try to $GET the record. ; $GET RAB=SYSRAB ; ... ON_ERR 20$ ; Branch on error MOVAL SYSREC+UAF$T_USERNAME,R0 ; Point to username MOVAL SYSREC+UAF$T_OWNER,R1 ; Point to owner name ; ; Now use the $FAO system service to Format the ASCII Output. ; $FAO_S CTRSTR=FAO_STR, - ; Format the output string OUTLEN=FAO_OUT_D, - ; ... The length returned OUTBUF=FAO_OUT_D, - ; ... P1=#12,- ; ... Only use 12 bytes P2=R0,- ; ... P3=R1 ; ... PUSHAQ FAO_OUT_D ; Print it CALLS #1,G^LIB$PUT_OUTPUT ; ... ; 20$: CMPL #RMS$_RNF,R0 ; Valid user? BNEQU 30$ ; Yes - continue PUSHAQ MSG1 ; Print "Username not found." CALLS #1,G^LIB$PUT_OUTPUT ; ... 30$: PUSHL SYSRAB+RAB$L_STV ; Push the RAB STV value CLRL -(SP) ; No FAO args for STS PUSHL SYSRAB+RAB$L_STS ; Push the RAB STS value CALLS #3,G^LIB$SIGNAL ; Signal it $CLOSE FAB=SYSFAB ; Close SYSUAF BRB 50$ ; Branch to exit 40$: PUSHL SYSFAB+FAB$L_STV ; Push the STV value CLRL -(SP) ; No FAO args for STS PUSHL SYSFAB+FAB$L_STS ; Push the STS value CALLS #3,G^LIB$SIGNAL ; Signal the error 50$: RET ; Return to caller (VMS) .END WHO