$!	RMSGLOBUF.COM - Show files using RMS global buffers
$!	Created: December 1989 by Harry Flowers
$!
$!	This command procedure shows files for which RMS global buffers are
$!	currently being used.  It invokes INSTALL and SDA (CMKRNL privilege
$!	is required) to get the necessary information to use DUMP/FILE on
$!	INDEX.SYS on the appropriate disk drive.  It is highly dependent on
$!	the format of output from INSTALL, SDA, and DUMP.
$!	
$	DEBUG = "FALSE"				! Set to "TRUE" to debug
$!
$	DBG = "!"
$	NDBG = ""
$	IF DEBUG THEN DBG = ""
$	IF DEBUG THEN NDBG = "!"
$'DBG'	SAVERIFY = F$VERIFY(1)
$'NDBG'	SAVERIFY = F$VERIFY(0)
$	RPTFAO1 = "| !76AS |"
$	RPTFAO2 = "| File id: !23AS  Global buffer count: !6AS  File name(s): |"
$	SEPLINE = F$FAO("+!78*-+")
$	ON ERROR THEN GOTO ABORTED
$	ON CONTROL_Y THEN GOTO ABORTED
$	INSTALL = "$INSTALL/COMMAND"
$	INSTALL LIST/GLOBAL/SUMMARY		! Show available global pages
$	WRITE SYS$OUTPUT ""
$	WRITE SYS$OUTPUT SEPLINE
$	WRITE SYS$OUTPUT F$FAO(RPTFAO1,-
		"         RMS Global Buffered File Report on ''F$TIME()'")
$	WRITE SYS$OUTPUT SEPLINE
$!	The FCB is xxxxxxxx from RMS$xxxxxxxx from INSTALL LIST/GLOBAL
$	DEFINE/USER_MODE SYS$OUTPUT RMSGLOBUF.TMP
$	INSTALL LIST/GLOBAL
$	DEFINE/USER_MODE SYS$OUTPUT NL:
$	DEFINE/USER_MODE SYS$ERROR  NL:
$	SEARCH/OUTPUT=RMSGLOBU2.TMP RMSGLOBUF.TMP "RMS$8"
$	IF $STATUS .EQS. "%X08D78053" THEN GOTO NONE_FOUND
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;
$	OPEN/READ FCBFIL RMSGLOBU2.TMP
$ LOOP:
$	READ/END=FINISHED FCBFIL FCB
$	WRITE SYS$OUTPUT F$FAO(RPTFAO1,FCB)	! Show them the entire line
$	FCB = F$EXTRACT(4,8,FCB)		! Extract just the FCB
$	GOSUB FIND_FILE
$	WRITE SYS$OUTPUT SEPLINE
$	GOTO LOOP
$ FINISHED:
$	CLOSE FCBFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBU2.TMP;*
$	SAVERIFY = F$VERIFY(SAVERIFY)
$	EXIT
$ FIND_FILE:
$	OPEN/WRITE SDAINIT RMSGLOBUF.TMP	! Make our own SDA$INIT
$	WRITE SDAINIT "READ SYS$SYSTEM:SYSDEF.STB"
$	WRITE SDAINIT "DEFINE FCB=''FCB'"	! Define our FCB symbol
$	CLOSE SDAINIT
$	DEFINE/USER_MODE SDA$INIT RMSGLOBUF.TMP
$'NDBG'	DEFINE/USER_MODE SYS$OUTPUT NL:
$'NDBG'	DEFINE/USER_MODE SYS$ERROR  NL:
$	ANALYZE/SYSTEM				! Get the information
SET LOG SDA.TMP
EXAMINE       FCB+FCB$W_FID
EXAMINE   @(@(FCB+FCB$L_WLFL)+WCB$L_ORGUCB)+UCB$W_UNIT
EXAMINE @(@(@(FCB+FCB$L_WLFL)+WCB$L_ORGUCB)+UCB$L_DDB)+DDB$T_NAME
EXIT
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*
$	OPEN/READ SDAFIL SDA.TMP		! Read the information
$	READ/END=ABORTED SDAFIL LINE
$	READ/END=ABORTED SDAFIL FCB$W_FID
$	READ/END=ABORTED SDAFIL LINE
$	READ/END=ABORTED SDAFIL UCB$W_UNIT
$	READ/END=ABORTED SDAFIL LINE
$	READ/END=ABORTED SDAFIL DDB$T_NAME
$	CLOSE SDAFIL
$	DELETE/NOLOG/NOCONFIRM SDA.TMP;*	! Now, parse the information
$	FCB$W_FID = F$EXTRACT(4,4,F$ELEMENT(1," ",F$EDIT(FCB$W_FID,"COMPRESS")))
$	UCB$W_UNIT = F$EXTRACT(4,4,F$ELEMENT(1," ",F$EDIT(UCB$W_UNIT,"COMPRESS")))
$	DDB$T_NAME = F$EXTRACT(1,3,F$ELEMENT(1,"""",DDB$T_NAME))
$	FCB$W_FID = %X'FCB$W_FID'
$	UCB$W_UNIT = %X'UCB$W_UNIT'
$	DEVNAM = DDB$T_NAME + "''UCB$W_UNIT':"
$	SHOW DEVICE/OUTPUT=RMSGLOBUF.TMP 'DEVNAM' ! Get a "real" device name
$	OPEN/READ DEVFIL RMSGLOBUF.TMP
$	READ/END=ABORTED DEVFIL LINE
$	READ/END=ABORTED DEVFIL LINE
$	READ/END=ABORTED DEVFIL LINE
$	READ/END=ABORTED DEVFIL LINE
$	CLOSE DEVFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*
$	DEVNAM = F$ELEMENT(0," ",F$EDIT(LINE,"COMPRESS,TRIM"))
$	CLUSTER = F$GETDVI(DEVNAM,"CLUSTER")
$	MAXFILES = F$GETDVI(DEVNAM,"MAXFILES")
$	OFFSET = (MAXFILES+4095)/4096 + FCB$W_FID + (CLUSTER*4)
$	DUMP/FILE/BLOCK=(START='OFFSET',COUNT=1)/OUTPUT=RMSGLOBUF.TMP -
		 'DEVNAM'[0,0]INDEXF.SYS
$	SEARCH/OUTPUT=RMSGLOBU3.TMP/EXACT/MATCH=OR RMSGLOBUF.TMP -
		"File name:","File identification:","Global buffer count:"
$	OPEN/READ NAMFIL RMSGLOBU3.TMP
$	READ/END=ABORTED NAMFIL FID
$	READ/END=ABORTED NAMFIL BUFCNT
$	READ/END=ABORTED NAMFIL FILNAM
$	CLOSE NAMFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*,RMSGLOBU3.TMP;*
$	FID = F$ELEMENT(1,":",F$EDIT(FID,"COLLAPSE"))
$	BUFCNT = F$ELEMENT(1,":",F$EDIT(BUFCNT,"COLLAPSE"))
$	FILNAM = F$ELEMENT(1,":",F$EDIT(FILNAM,"COLLAPSE"))
$	WRITE SYS$OUTPUT F$FAO(RPTFAO2,FID,BUFCNT)
$ LOOP2:
$	FILE_NAME = F$SEARCH("''DEVNAM'[*...]''FILNAM'")
$	IF FILE_NAME .EQS. "" THEN RETURN	! No more files match
$	FILE_FID = F$FILE_ATTRIBUTES(FILE_NAME,"FID")
$	IF FILE_FID .EQS. FID THEN WRITE SYS$OUTPUT F$FAO(RPTFAO1,FILE_NAME)
$	GOTO LOOP2
$ NONE_FOUND:
$	WRITE SYS$OUTPUT F$FAO(RPTFAO1,-
		"No RMS global buffers are currently in use.")
$	WRITE SYS$OUTPUT SEPLINE
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*,RMSGLOBU2.TMP;*
$	SAVERIFY = F$VERIFY(SAVERIFY)
$	EXIT
$ ABORTED:
$	SET NOON
$	WRITE SYS$OUTPUT F$FAO(RPTFAO1,-
		"Error - RMSGLOBUF aborted.")
$	WRITE SYS$OUTPUT SEPLINE
$	IF F$TRNLNM("FCBFIL") .NES. "" THEN CLOSE FCBFIL
$	IF F$TRNLNM("SDAFIL") .NES. "" THEN CLOSE SDAFIL
$	IF F$TRNLNM("DEVFIL") .NES. "" THEN CLOSE DEVFIL
$	IF F$TRNLNM("NAMFIL") .NES. "" THEN CLOSE NAMFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBU%.TMP;*
$	EXIT