|
HP OpenVMS Systemsask the wizard |
|
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
|