 |
» |
|
|
|
 |
Copyright (c) Digital Equipment Corporation 1989, 1991. All rights reserved
LAYERED PRODUCT: VAX PLI V3.4 OP/SYS: VMS V5.4-1
SOURCE: Digital Customer Support Center
OVERVIEW:
This program demonstrates how to call the ACP QIO system service to
read and modify file attributes.
*** CAUTION ***
This sample program has been tested using VAX PLI V3.4 on VMS V5.4-1.
However, we cannot guarantee its effectiveness because of the possibility
of errors in transmitting or implementing it. It is meant to be used as
a template for writing your own program, and it may require modification
for use on your system.
PROGRAM NOTES:
The example consists of a command procedure that creates a PLI program,
a macro subroutine GETFID which is called to obtain the file-id and a
macro routine to expand the $ATRDEF symbols. The revision date and
count are modified for the specified file.
PROGRAM EXAMPLE:
$ create acp.pli
ACPQIO: proc options(main);
%include $iodef;
%include $ssdef;
%include $stsdef;
%include $atrdef;
%include sys$qio;
%include sys$assign;
%include sys$dassgn;
%include str$trim;
/* file information block */
dcl 01 fib_overlay union,
02 fib char(22),
02 fib_break_down,
03 fib$_acctl fixed bin(31),
03 fib$w_fid,
05 fib$_num fixed bin(15),
05 fib$_seq fixed bin(15),
05 fib$_rev fixed bin(15),
03 fib$w_did,
05 did_num fixed bin(15),
05 did_seq fixed bin(15),
05 did_rvn fixed bin(15),
03 fib$l_wcc fixed bin(31),
03 fib$w_nmctl fixed bin(15);
/* attribute list */
dcl 1 attr_control_block,
3 attr1_size fixed bin(15) init(atr$s_ascdates),
3 attr1_type fixed bin(15) init(atr$c_ascdates),
3 attr1_addr pointer,
3 attr_terminator fixed bin(31) init(0);
dcl 1 asc_dates,
3 rev_count fixed bin(15),
3 rev_date char(7),
3 rev_time char(6),
3 cre_date char(7),
3 cre_time char(6),
3 exp_date char(7),
3 exp_time char(6);
dcl 1 iosb,
03 iosb_stat fixed bin(15),
03 iosb_stat2 fixed bin(15),
03 iosb_stat3 fixed bin(15),
03 iosb_stat4 fixed bin(15);
dcl chan fixed bin(15);
dcl func bit(32) aligned;
dcl device_name char(12);
dcl file_name char(63);
dcl file_name_len fixed bin(15);
dcl directory_name char(32);
dcl directory_name_len fixed bin(15);
dcl device_name_len fixed bin(15);
dcl full_file_name char(255);
dcl full_file_name_len fixed bin(15);
dcl getfid entry(any,any);
attr1_addr = addr(asc_dates);
/* assign a channel to the disk for the sys$qio call */
put skip list('Enter disk name: ');
get list(device_name);
sts$value = SYS$ASSIGN(device_name,chan,,);
if ^sts$success
then signal vaxcondition(sts$value);
sts$value = STR$TRIM(device_name,device_name,device_name_len);
if ^sts$success
then signal vaxcondition(sts$value);
put skip list('Enter the directory name: ');
get list(directory_name);
sts$value = STR$TRIM(directory_name,directory_name,directory_name_len);
if ^sts$success
then signal vaxcondition(sts$value);
put skip list('Enter the file name: ');
get list(file_name);
sts$value = STR$TRIM(file_name,file_name,file_name_len);
if ^sts$success
then signal vaxcondition(sts$value);
full_file_name = substr(device_name,1,device_name_len) ||
substr(directory_name,1,directory_name_len) ||
substr(file_name,1,file_name_len);
sts$value = STR$TRIM(full_file_name,full_file_name,full_file_name_len);
if ^sts$success
then signal vaxcondition(sts$value);
put skip list ('accessing file:',substr(full_file_name,1,full_file_name_len));
/*get the file ID for the file to be accessed. Calling a macro
routine to return the FID */
call GETFID(desc(substr(full_file_name,1,full_file_name_len)),ref(fib$w_fid));
/*call ACP QIO system service with a function code of IO$_ACCESS to
initiate a read attributes operation*/
func = io$_access;
sts$value = SYS$QIOW(,chan,func,iosb,,,desc(fib),,,,ref(attr_control_block),);
if ^sts$success
then signal vaxcondition(sts$value);
if ss$_normal ^= iosb_stat
then signal vaxcondition(iosb_stat);
put skip list('File Accessed: ');
put skip list(' creation date: ',cre_date);
put skip list(' revision date: ',rev_date);
put skip list(' expiration date: ',exp_date);
/* the revision date and count will be updated, to do this the
appropriate fields in the attribute buffer are updated and the
call to the ACP QIO service is called */
rev_date = '31DEC99';
rev_count = 1;
func = io$_modify;
sts$value = SYS$QIOW(,chan,func,iosb,,,desc(fib),,,,ref(attr_control_block),);
if ^sts$success
then signal vaxcondition(sts$value);
if ss$_normal ^= iosb_stat
then signal vaxcondition(iosb_stat);
sts$value = SYS$DASSGN(chan);
if ^sts$success
then signal vaxcondition(sts$value);
end ACPQIO;
$ create getfid.mar
.TITLE GETFID - SUBROUTINE TO RETURN FILE ID.
.PSECT DATA,LONG
;
; Calling sequence:
;
; CALL GETFID ( FILEN, FID ) where
;
; FILEN : The address of a string descriptor for the file name
;
; FID : The address of a 3 word integer array for the return
; file ID.
; Note:
; GETFID can also be called as an integer function so that the
; return status can be tested.
;
; STATUS = GETFID ( FILEN, FID )
;
INFAB: $FAB NAM=NAMBLK,FNA=NAME
INRAB: $RAB FAB=INFAB
NAMBLK: $NAM
NAME: .BLKB 63 ;MAX FILE NAME SIZE=63
.PSECT CODE
GETFID:: .WORD ^M<R2,R3,R4,R5,R6,R7>
MOVL 4(AP),R7 ;GET FNAM DESC. ADDR.
MOVB (R7),W^INFAB+FAB$B_FNS ;SET FILE NAME SIZE
MOVZBL (R7),R6 ;BYTE COUNT TO R6
MOVL 4(R7),R7 ;GET STRING ADDR.
MOVC3 R6,(R7),W^NAME ;MOVE NAME TO "NAME"
$OPEN FAB=W^INFAB ;OPEN FILE
BLBC R0,EXIT ;IF LBC REPORT ERROR
MOVL 8(AP),R3 ;GET ADDR. FOR FID
MOVAL W^NAMBLK,R2 ;GET NAMEBLK ADDRESS
MOVW W^NAM$W_FID_NUM(R2),(R3)+ ;MOVE FID
MOVW W^NAM$W_FID_SEQ(R2),(R3)+ ;MOVE FILE SEQ #
MOVW W^NAM$W_FID_RVN(R2),(R3) ;MOVE FILE REL VOL #
$CLOSE FAB=W^INFAB ;CLOSE FILE
BLBC R0,EXIT ;IF LBC REPORT ERROR
MOVZWL #SS$_NORMAL,R0 ;SET SUCCESS RET CODE
EXIT: RET
.END
$ create atrdef.mar
$ deck
.title ATRDEF
$ATRDEF GLOBAL
.end
$ eod
$ pli acp.pli
$ macro getfid.mar
$ macro atrdef.mar
$ link acp,getfid,atrdef
$ assign sys$command sys$input
$ run acp
$ del acp.pli;
$ del acp.obj;
$!del acp.exe;
$ del getfid.mar;
$ del getfid.obj;
$ del atrdef.mar;
$ del atrdef.obj;
|
|
|
buy online or call 1.800.AT.COMPAQ
|
|
