HP OpenVMS Systemsask the wizard |
The Question is: Can't find a program callable equivalent to F$FILE_ATTRIBUTES() for Fortran or C. I need to get the creation date for a file. Is there a system service or rtl function which I can use? Thank you for your help. The Answer is :
Please see the I/O User's Reference Manual for the I/O ACP interface
(IO-ACPCONTROL) or see the RMS services programming interface.
A Fortran example follows:
! 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)'
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
END UNION
END STRUCTURE
RECORD /fullxab/datxab,fhcxab ! allocate 2 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
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
|