$!----------------------------------------------------------------------------+
$!	RMSGLOBUF.COM - Show files using RMS global buffers                   |
$!----------------------------------------------------------------------------+
$!	Author: 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.  It doesn't work
$!	on bound volume sets.
$!	
$	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 = "| GblBuffs:!3AS FilNam:!57AS|"
$	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/WRITE SDAINP RMSGLOBUF.TMP
$	OPEN/READ FCBFIL RMSGLOBU2.TMP
$	X = 1
$	WRITE SDAINP "$	DEFINE/USER_MODE SDA$INIT   NL:"
$	WRITE SDAINP "$''NDBG'	DEFINE/USER_MODE SYS$OUTPUT NL:"
$	WRITE SDAINP "$''NDBG'	DEFINE/USER_MODE SYS$ERROR  NL:"
$	WRITE SDAINP "$	ANALYZE/SYSTEM	! Get the information"
$	WRITE SDAINP "READ SYS$SYSTEM:SYSDEF.STB"
$	WRITE SDAINP "SET LOG RMSGLOSDA.TMP"
$ FCBLOOP:
$	READ/END=FCBDONE FCBFIL FCBLIN'X'
$	FCB = F$EXTRACT(4,8,FCBLIN'X')	! Extract just the FCB
$	WRITE SDAINP "EXAMINE       ''FCB'+FCB$W_FID"
$	WRITE SDAINP "EXAMINE   @(@(''FCB'+FCB$L_WLFL)+WCB$L_ORGUCB)+UCB$W_UNIT"
$	WRITE SDAINP "EXAMINE @(@(@(''FCB'+FCB$L_WLFL)+WCB$L_ORGUCB)+UCB$L_DDB)+DDB$T_NAME"
$	X = X + 1
$	GOTO FCBLOOP
$ FCBDONE:
$	FILCNT = X - 1
$	WRITE SDAINP "EXIT"
$	WRITE SDAINP "$	EXIT"
$	CLOSE SDAINP
$	CLOSE FCBFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBU2.TMP;*
$	@RMSGLOBUF.TMP
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*
$	OPEN/READ SDAFIL RMSGLOSDA.TMP		! Read the information
$	X = 1
$	OLDSKNAM = ""
$	OLDIRFID = 0
$ FIDLOOP:
$	WRITE SYS$OUTPUT F$FAO(RPTFAO1,FCBLIN'X') ! Show them the entire line
$	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
$	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'
$	DSKNAM = DDB$T_NAME + "''UCB$W_UNIT':"
$	IF DSKNAM .EQS. OLDSKNAM THEN GOTO FIND_FILE
$	OLDSKNAM = DSKNAM
$	DEVNAM = F$DEVICE("*''DSKNAM'","DISK") - "_"
$	CLUSTER = F$GETDVI(DEVNAM,"CLUSTER")
$	MAXFILES = F$GETDVI(DEVNAM,"MAXFILES")
$ FIND_FILE:
$	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 -
		"Global buffer count:","Back link file identification:",-
		"File name:"
$	OPEN/READ NAMFIL RMSGLOBU3.TMP
$	READ/END=ABORTED NAMFIL BUFCNT
$	READ/END=ABORTED NAMFIL BCKLNK
$	READ/END=ABORTED NAMFIL FILNAM
$	CLOSE NAMFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*,RMSGLOBU3.TMP;*
$	BUFCNT = F$ELEMENT(1,":",F$EDIT(BUFCNT,"COLLAPSE"))
$	BCKLNK = F$ELEMENT(1,":",F$EDIT(BCKLNK,"COLLAPSE"))
$	FILNAM = F$ELEMENT(1,":",F$EDIT(FILNAM,"COLLAPSE"))
$	DIRFID = F$INTEGER(F$ELEMENT(0,",",BCKLNK) - "(")
$	IF DIRFID .EQ. OLDIRFID THEN GOTO SHOWIT
$	OLDIRFID = DIRFID
$	DIRPATH = "]"
$ DIRLOOP:
$	OFFSET = (MAXFILES+4095)/4096 + DIRFID + (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 -
		"Back link file identification:","File name:"
$	OPEN/READ NAMFIL RMSGLOBU3.TMP
$	READ/END=ABORTED NAMFIL BCKLNK
$	READ/END=ABORTED NAMFIL DIRNAM
$	CLOSE NAMFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOBUF.TMP;*,RMSGLOBU3.TMP;*
$	BCKLNK = F$ELEMENT(1,":",F$EDIT(BCKLNK,"COLLAPSE"))
$	DIRNAM = F$ELEMENT(1,":",F$EDIT(DIRNAM,"COLLAPSE"))
$	DIRPATH = "." + F$PARSE(DIRNAM,,,"NAME") + DIRPATH
$	DIRFID = F$INTEGER(F$ELEMENT(0,",",BCKLNK) - "(")
$	IF DIRFID .NE. 4 THEN GOTO DIRLOOP
$	DIRPATH = "[" + DIRPATH - "."
$ SHOWIT:
$	FILE_NAME = DEVNAM + DIRPATH + FILNAM
$	WRITE SYS$OUTPUT F$FAO(RPTFAO2,BUFCNT,FILE_NAME)
$	WRITE SYS$OUTPUT SEPLINE
$	X = X + 1
$	IF X .LE. FILCNT THEN GOTO FIDLOOP
$	CLOSE SDAFIL
$	DELETE/NOLOG/NOCONFIRM RMSGLOSDA.TMP;*
$	SAVERIFY = F$VERIFY(SAVERIFY)
$	EXIT
$ 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("SDAINP") .NES. "" THEN CLOSE SDAINP
$	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 RMSGLO%%%.TMP;*
$	EXIT