|
HP OpenVMS Systemsask the wizard |
|
The Question is: How do I find the Creation/Revision Date/Time for files from within VMS Fortran. The information in Chapter 11 of the Compaq Fortran User Manual for Open VMS provides a start, but as always, the devil is in the detail. The Answer is :
Sample FORTRAN code for getting some RMS attributes
! 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
|