Article 128359 of comp.os.vms:
Path: nntpd.lkg.dec.com!pa.dec.com!decuac.dec.com!haven.umd.edu!news.umbc.edu!cs.umd.edu!zombie.ncsc.mil!paladin.american.edu!gatech!howland.reston.ans.net!newsfeed.internetmci.com!news.mathworks.com!news.kei.com!ub!acsu.buffalo.edu!acsreb
From: acsreb@acsu.buffalo.edu (Reb Carter)
Newsgroups: comp.lang.fortran,comp.os.vms
Subject: Re: Finding file size from DEC Fortran
Date: 31 Aug 1995 18:48:02 GMT
Organization: State University of New York at Buffalo
Lines: 181
Message-ID: <425052$93p@azure.acsu.buffalo.edu>
References: <41i6nm$bnv@trog.dra.hmg.gb> <peter-2608951814570001@piglet.demon.co.uk> <1995Aug31.105322.1521@gems.vcu.edu>
NNTP-Posting-Host: conciliator.acsu.buffalo.edu
NNTP-Posting-User: acsreb
Xref: nntpd.lkg.dec.com comp.lang.fortran:31862 comp.os.vms:128359


The following code, which is still working on OpenVMS 6.1 AXP, should show
you what you'll need to do to find out the 'real' size of a file.  If you
just need to know the allocated size, that info is in the fab$l_alq field
of the files fab.  The info can be found in the Record Management Services
manual.  There is also an example of a 'useropen' routine in the Fortran
users guide.

	===== included code ======

	INTEGER*4 FUNCTION Jbc_user_open(fab,rab,lun) !a user open routine
C
C		Determines the size of file to be queued
C
C Inputs:	fab		Read only file access block structure.
C		rab		Read only record access block.
C		lun		Read only, passed by reference. logical
C				unit number.
C		file_size	Write, passed by reference in common block. 
C				The size or estimated size of the file to be 
C				printed.
C		status		Write, passed by reference in common block.
C				The open status.
C		stv		Write, passed by reference in common block.
C				The extended status information.
C
C Returns:	file_size	Size in blocks of the file
C		status		The open status.
C		stv		The extended status information.
C
C Exits:	RMS$_NORMAL	Normal completion status.
C		xp_utl		Unexpected return from utilies.
C
C
C Description:	Searches the FAB XAB chain for the FHC eXtended Access Block.
C		This XAB contains the End of File Block information.
C
C===============================================================================
C
C		
C		Written by:
C
C		SUNY at Buffalo 
C			University Computing Services
C			Academic User Services
C			Computer Graphics Group
C
C		Programmer: 	Reb Carter
C		Date:		September 26, 1988
C		Environment:	DEC VAX/VMS Ver. 4.7
C				XPRint
C		
C
C		Purpose - Get the block size of a file.
C
C	-------------------- Modification History ---------------------
C
C			Date:		5-AUG-1991
C			Programmer:	Reb Carter
C			Reason:		Modify/add comments and change size
C					of file_size from Integer*2 to 
C					Integer*4.
C
C===============================================================================
C
C===============================================================================
C
C    *********************************************************************
C    *                                                                   *
C    *   There are no expressed or implied warranties, including without *
C    *   limitation implied warranties of merchantability or fitness for *
C    *   a particular purpose, with regard to this software or its       *
C    *   documentation.  The State University of New York at Buffalo     *
C    *	 University Computing Services, Buffalo, New York 14260   does   *
C    *   not acknowledge or assume any liability resulting from the use  *
C    *   of this software or its documentation.                          *
C    *                                                                   *
C    *********************************************************************
C
C===============================================================================
C
	IMPLICIT	NONE

	INCLUDE '($FABDEF)'
	INCLUDE '($RABDEF)'
	INCLUDE '($XABFHCDEF)'

	EXTERNAL	RMS$_NORMAL
	EXTERNAL	xp_xputl

	INTEGER*4	SYS$OPEN
	INTEGER*4	lun

	RECORD /fabdef/ fab
	RECORD /rabdef/ rab

	BYTE		xab_code(1)		!xab$c_cod
	INTEGER*4	xab_ebk(1)
	INTEGER*4	xab_code_address
	INTEGER*4	xab_address
	INTEGER*4	xab_offset
	INTEGER*4	xab_nxt(1)		!xab$l_nxt

	EQUIVALENCE	(xab_code(1),xab_ebk(1),xab_nxt(1))

	PARAMETER	xab_nxt_offset = 1	!longword offset to nxt
	PARAMETER	xab_ebk_offset = 4	!longword offset to ebk
	PARAMETER	search_xabs = 5

	INTEGER*4	file_size
	INTEGER*4	status
	INTEGER*4	stv
	COMMON /Jbc_file_info/	file_size, status, stv

	INTEGER *2	loop

C   Begin Jbc_user_open

D	CALL trace_routine('Jbc_user_open','routine entered')

	status = SYS$OPEN(fab)

	IF(.NOT. status) THEN

		jbc_user_open = status
		stv = fab.FAB$L_STV
D		CALL trace_routine('Jbc_user_open','routine exited')
		RETURN

	ENDIF

C		Find the offset to xabfhc record

	file_size = 0
	xab_code_address = %LOC(xab_code(1))
	xab_address = fab.FAB$L_XAB 

	DO loop = 1,search_xabs

		xab_offset = xab_address - xab_code_address + 1

		IF(xab_code(xab_offset) .EQ. XAB$C_FHC) THEN

			IF(MOD(xab_offset,4) .NE. 0) xab_offset = xab_offset + 4
			xab_offset = (xab_offset / 4) + xab_ebk_offset 
			GOTO 100

		ENDIF !code

		IF(MOD(xab_offset,4) .NE. 0) xab_offset = xab_offset + 4
		xab_offset = (xab_offset / 4) + xab_nxt_offset 
		xab_address = xab_nxt(xab_offset)

	ENDDO !1 to search_xabs

C		Didn't find the File header XAB - Abort

	CALL trace_routine('Jbc_user_open','Failed to find File Header')
	CALL LIB$SIGNAL(xp_xputl,%VAL(1),'Jbc_user_open')
	RETURN

C		Found the file header XAB continue

100	file_size = xab_ebk(xab_offset)
	jbc_user_open = %LOC(RMS$_NORMAL)
	stv = fab.FAB$l_STV

C		The Min size of VBN seems to be 1
C			So correct for zero block files

	IF(file_size .GT. fab.FAB$L_ALQ) file_size = fab.FAB$L_ALQ

D	CALL trace_routine('Jbc_user_open','routine exited')

	RETURN

C   End Jbc_user_open

	END	
































