WARNOCK@PRISM.CLEMSON.EDU (Todd Warnock) (10/11/87)
I recently posted a question about setting the creation date in a file.
I think I was a bit misleading in what the problem really was. I can set the
creation date on a new file, but I am having trouble on an existing file. I am
enclosing the code that does this, in hopes of getting some help/pointers on
where I am going wrong.
On a similar note, how does one use the debugger on useropen routines ?
Thanks in advance for the help !
Todd Warnock
VAX Systems
Clemson University
Clemson, South Carolina 29634-2803
ARPA: Warnock@Prism.Clemson.EDU
BITnet: Warnock@Clemson
-------------------------- code segment follows --------------------------------
program set_creation_date
c
implicit none
c
external set_cdt
c
common /creation_date/ create_date
c
integer*4 create_date(2)
integer*4 sys$bintim
integer*4 status
character*23 ascii_date
character*255 file_name
c
c Get the creation date to set
c
ascii_date = '01-JAN-2000 00:00:00.00'
c
c Get the filename to modify
c
file_name = 'new.file'
c
c convert the ASCII date to quadword
c
status = sys$bintim (%descr(ascii_date),%ref(create_date))
if (.not.status) call lib$stop (%val(status))
c
c Create the file (if it doesn't exist)
c
open (unit=1,status='unknown',organization='sequential',
+ file=file_name,useropen=set_cdt)
c
close (unit=1)
end
c
c useropen routine
c
integer*4 function set_cdt (fab,rab,lun)
c
include '($fabdef)'
record /fabdef/ fab
c
include '($rabdef)'
record /rabdef/ rab
c
include '($xabdatdef)'
record /xabdatdef/ useropen_xabdat
common /creation_date/ create_date
c
integer*4 create_date(2)
integer*4 sys$create
integer*4 sys$connect
c
c initialize the XABDAT
c
useropen_xabdat.xabdatdef$$_fill_1 = xab$c_dat
useropen_xabdat.xabdatdef$$_fill_2 = xab$c_datlen
useropen_xabdat.xab$l_cdt0 = create_date(1)
useropen_xabdat.xab$l_cdt4 = create_date(2)
fab.fab$l_xab = %loc(useropen_xabdat)
c
set_cdt = sys$create(%ref(fab))
if (.not.set_cdt) call sys$exit(%val(set_cdt))
c
set_cdt = sys$connect (%ref(rab))
if (.not.set_cdt) call sys$exit(%val(set_cdt))
c
return
end