HP OpenVMS Systems

ask the wizard
Content starts here

Obtaining RMS file size?

» close window

The Question is:

 
Hello Mr Wizard
 
I am looking for a method of obtaining the size of a file, NOT the allocation
 from within a Fortran routine. I thought this would be a simple trivial task
 but alas I am proved wrong.
 
Can you help.
 
Regards Jim
 


The Answer is :

 
    RMS does NOT keep track of the number of user data bytes in a file.
    The only reliable way to obtain that, is to read the file and count!
    RMS does maintain the ALLOCATED blocks which you can readily find
    in the FAB for the file (USEROPEN or FOR$FAB).
 
    RMS also maintains the EOF block and byte which you can get from
    the XABFHC. This is a little more tricky, involving address calculations.
    The EOF often has a close relation to the user bytes, much closer than
    the ALQ, but it is not the same due to overhead in the file:
    	record-length word per record, fill byte for odd sized records...
 
 
  Sample program which returns some RMS fields for a given file:
 
 
!    The subroutine get_create_date_siz gets the RMS CDT, RDT, ALQ and EBK
!    fields. You can consult SYS$LIBRARY:FORSYSDEF.TLB entry $XABDATDEF and
!    $XABFHCDEF to find the field names of other fields, if you should ever
!    need them.
 
        program rms_test
 
! test program for get_create_date_siz
 
        IMPLICIT NONE
        character*80 filename
        integer*2 leng
        integer*4 cdat(2),rdat(2),status,get_create_date_size
        integer*4 alq,siz
        character*23 scdat,srdat
        print '('' Enter filename: '',$)'
        accept 10,filename
10      FORMAT(A80)
 
        status=get_create_date_size(filename,cdat,rdat,alq,siz)
        if(status) then
          call sys$asctim (,scdat,cdat,)
          call sys$asctim (,srdat,rdat,)
          print *,filename
          print *,'     created ',scdat
          print *,'     revised ',srdat
          print *,'     ',siz,'/',alq,' blocks'
        else
          print *,'Error status='
          filename=' '
          call sys$getmsg (%val(status),leng,filename,,)
          print *,filename(1:leng)
        endif
        end
 
        options /extend_source
        integer function get_create_date_size(filename,cdat,rdat,alq,siz)
        implicit none
        character*(*) filename
        integer*4 cdat(2),rdat(2),alq,siz
 
        include '($FABDEF)'     ! RMS definitions from FORSYSDEF.TLB
        include '($XABDEF)'
        include '($XABDATDEF)'
        include '($XABFHCDEF)'
        include '($XABPRODEF)'
 
        integer status,sys$open,sys$close       ! RMS routines
 
        record/fabdef/fab
 
!  the following structure defines an XAB by overlaying the XABDEF, XABDATDEF
!  and XABFHCDEF structures. This allows access to the XABDAT and XABFHC fields
!  as well as the common XAB fields which are defined only in XABDEF.
 
        STRUCTURE /fullxab/
           UNION
             MAP
                record/xabdef/xab
             END MAP
             MAP
                record/xabdatdef/xabdat
             END MAP
             MAP
                record/xabfhcdef/xabfhc
             END MAP
             MAP
                record/xabprodef1/xabpro
             ENDMAP
           END UNION
        END STRUCTURE
 
        RECORD /fullxab/datxab,fhcxab,proxab            ! allocate 3 XABs
 
        call lib$movc5(0,0,0,fab$c_bln,fab)     ! Clear FAB
        fab.fab$b_bln=fab$c_bln                 ! set FAB options (see RMS
        fab.fab$b_bid=fab$c_bid                 !   manual for details)
        fab.fab$b_fac=fab$m_get
        fab.fab$b_shr=fab$m_shrdel+fab$m_shrget+fab$m_shrput+fab$m_shrUPD
        fab.fab$l_fop=fab$m_SQO
 
        fab.fab$l_fna=%loc(filename)            ! set file name to open
        fab.fab$b_fns=len(filename)             ! and length of name
 
        fab.fab$l_XAB = %loc(datxab)            ! chain to XABDAT
 
        call lib$movc5(0,0,0,XAB$C_DATLEN,datxab)       ! Clear XAB as XABDAT
        datxab.xab.xab$b_bln=XAB$C_DATLEN               ! set length
        datxab.xab.xab$b_cod=XAB$C_DAT                  ! fill as XABDAT
        datxab.xab.xab$l_nxt=%LOC(fhcxab)               ! chain to XABFHC
 
        call lib$movc5(0,0,0,XAB$C_FHCLEN,fhcxab)       ! Clear XAB as XABFHC
        fhcxab.xab.xab$b_bln=XAB$C_FHCLEN               ! set length
        fhcxab.xab.xab$b_cod=XAB$C_FHC                  ! fill as XABFHC
        fhcxab.xab.xab$l_nxt=%LOC(proxab)               ! chain to XABFHC
 
        call lib$movc5(0,0,0,XAB$C_PROLEN,proxab)       ! Clear XAB as XABPRO
        proxab.xab.xab$b_bln=XAB$C_PROLEN               ! set length
        proxab.xab.xab$b_cod=XAB$C_PRO                  ! fill as XABPRO
 
        status=sys$open(fab)
 
        if(status) then
          CALL lib$movc3(8,datxab.xab.xab$q_rdt,rdat)   ! get revision date
          CALL lib$movc3(8,datxab.xabdat.xab$q_cdt,cdat)! get creation date
          alq=fab.fab$l_alq             ! get allocated size
          siz=fhcxab.xabfhc.xab$l_ebk   ! get used size (=EOF block)
          status=sys$close(fab)         ! close file
        endif
 
        get_create_date_size=status     ! return RMS status
        return
        end

answer written or last revised on ( 22-NOV-2000 )

» close window