Copyright (c) Digital Equipment Corporation 1989. All rights reserved
LAYERED PRODUCT: PLI V3.2     OP/SYS: VMS V5.0

SOURCE:     Digital Customer Support Center


OVERVIEW:

This program demonstrates how to read the accounting file,
ACCOUNTNG.DAT from a PLI program.


*** CAUTION ***

This sample program has been tested using:  PRODUCT: PLI V3.2 on
OPERATING SYSTEM: VMS V5.0.  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 program reads the accounting file, called ACCOUNTNG.DAT.  However,
it cannot read the version of the file that is currently being written
to by the system, because it is locked.  In order to close the current
file and open a new one, enter this DCL command:

   SET ACCOUNTING/NEW_FILE

If Accounting is not being run on the system in question, enter SET
ACCOUNTING/ENABLE.

The program reads each accounting record.  For certain types of
records, information is extracted from the packets and printed to
SYS$OUTPUT.


PROGRAM EXAMPLE:


test: proc options (main);

%include $acrdef;

dcl ACCTG file record input;
/* overlays are used so that pointer arithmetic can be performed */
dcl 1 datapointers,
      2 pointer1 union,
        3 record_ptr pointer,
        3 record_addr fixed bin(31),
      2 pointer2 union,
        3 resource_ptr pointer,
        3 resource_addr fixed bin(31),
      2 pointer3 union,
        3 image_ptr pointer,
        3 image_addr fixed bin(31),
      2 pointer4 union,
        3 user_ptr pointer,
        3 user_addr fixed bin(31),
      2 pointer5 union,
        3 print_ptr pointer,
        3 print_addr fixed bin(31),
      2 pointer6 union,
        3 kid_ptr pointer,
        3 kid_addr fixed bin(31),
      2 pointer7 union,
        3 filename_ptr pointer,
        3 filename_addr fixed bin(31),
      2 pointer8 union,
        3 username_ptr pointer,
        3 username_addr fixed bin(31);
dcl 1 counters,
      2 record_ctr fixed bin(31) init(0),
      2 prcdel_ctr fixed bin(31) init(0),
      2 imgdel_ctr fixed bin(31) init(0),
      2 sysinit_ctr fixed bin(31) init(0),
      2 logfail_ctr fixed bin(31) init(0),
      2 print_ctr fixed bin(31) init(0),
      2 user_ctr fixed bin(31) init(0),
      2 filefl_ctr fixed bin(31) init(0),
      2 filebl_ctr fixed bin(31) init(0);
dcl 1 p_pointer union,
      2 packet_ptr pointer,
      2 packet_addr fixed bin(31),
      2 packet_char char(4);
dcl 1 p_array(3) union,
      2 p_ptr pointer,
      2 p_addr fixed bin(31),
      2 p_char char(4);
dcl 1 packet_bits(3) union,
      2 p_type bit(7),
      2 packet_overlay,
        3 packet5to7 bit(3),
        3 packet1to4 bit(4);
dcl copy_bits bit(7);
dcl 1 acrbits union,
      2 testbits bit(7),
      2 overlay,
        3 bits5to7 bit(3),
        3 bits1to4 bit(4);
dcl andbits bit(7);
dcl n fixed bin(31);
dcl eof bit(1) init('0'b);
dcl 1 field_size union,
      2 field_length fixed bin(7),
      2 field_char char(1);
dcl username_offset fixed bin(15);
dcl user_string char(256) based;
dcl username char(255) var;
dcl acrv char(260) var;

on endfile(ACCTG)
  eof = ('1'b);
record_ptr =addr(acrv);
record_addr = record_addr + 2;

open file(ACCTG) input
        title('ACCOUNTNG.DAT');
read file(ACCTG) into(acrv);
loop: do while (^eof);
  record_ctr = record_ctr + 1;
/* Because of the way that bit strings are stored in PLI, it is
   necessary to load values into bits 1 to 4.  The record/packet
   types are stored in reverse order, so it is necessary to use the
   REVERSE builtin function */
  bits5to7 = '000'b;
  andbits = reverse(record_ptr -> acr$v_type);
/*andbits contains the record type found in the record header*/
/*testbits contains value of the particular record type being tested*/

/* process deleted record*/
PROCDEL:
  bits1to4 = bit(acr$k_prcdel);
  if (andbits = testbits)
     then do;
       put skip list('PRCDEL record: ');
       prcdel_ctr = prcdel_ctr + 1;
        packet5to7(1) = '000'b;
        packet5to7(2) = '000'b;
        packet1to4(1) = bit(acr$k_id);
        packet1to4(2) = bit(acr$k_resource);
        n = 2;
        call copy_packet;
        kid_ptr = p_ptr(1);
        resource_ptr = p_ptr(2);
        put edit ('pid:',kid_ptr->acr$l_pid,'uic:[',kid_ptr -> acr$w_grp,
                  ',',kid_ptr->acr$w_mem,']')
                 (a(4),f(10),x(1),a(5),f(3,0),a(1),f(3,0),a(1));
        username_addr = kid_addr + acr$k_idvar;
        field_char = substr(username_ptr -> user_string,1,1);
        username = substr(username_ptr ->user_string,2,field_length);
        put edit ('status: ',resource_ptr->acr$l_status,' user: ',
                  username)
                 (x(1),a(8),f(10,0),a(6),a);
     end;
 /* image deleted record*/
IMGDEL:
  bits1to4 = bit(acr$k_imgdel);
  if (andbits = testbits)
     then do;
       put skip list('IMGDEL record: ');
       imgdel_ctr = imgdel_ctr + 1;
     end;
  /* system initialization record*/
SYSINIT:
  bits1to4 = bit(acr$k_sysinit);
  if (andbits = testbits)
     then do;
        put skip list('SYSINIT record: ');
        sysinit_ctr = sysinit_ctr + 1;
        packet5to7(1) = '000'b;
        packet5to7(2) = '000'b;
        packet1to4(1) = bit(acr$k_id);
        packet1to4(2) = bit(acr$k_resource);
        n = 2;
        call copy_packet;
        kid_ptr = p_ptr(1);
        resource_ptr = p_ptr(2);
        put edit ('pid:',kid_ptr->acr$l_pid,'uic:[',kid_ptr -> acr$w_grp,
                  ',',kid_ptr->acr$w_mem,']')
                 (a(4),f(10),x(1),a(5),f(3,0),a(1),f(3,0),a(1));
        username_addr = kid_addr + acr$k_idvar;
        field_char = substr(username_ptr -> user_string,1,1);
        username = substr(username_ptr ->user_string,2,field_length);
        put edit ('status: ',resource_ptr->acr$l_status,' user: ',
                  username)
                 (x(1),a(8),f(10,0),a(6),a);
     end;
  /* login failure record*/
LOGIN:
  bits1to4 = bit(acr$k_logfail);
  if (andbits = testbits)
     then do;
        put skip list('LOGFAIL record: ');
        logfail_ctr = logfail_ctr + 1;
        packet5to7(1) = '000'b;
        packet5to7(2) = '000'b;
        packet1to4(1) = bit(acr$k_id);
        packet1to4(2) = bit(acr$k_resource);
        n = 2;
        call copy_packet;
        kid_ptr = p_ptr(1);
        resource_ptr = p_ptr(2);
        put edit ('pid:',kid_ptr->acr$l_pid,'uic:[',kid_ptr -> acr$w_grp,
                  ',',kid_ptr->acr$w_mem,']')
                 (a(4),f(10),x(1),a(5),f(3,0),a(1),f(3,0),a(1));
        username_addr = kid_addr + acr$k_idvar;
        field_char = substr(username_ptr -> user_string,1,1);
        username = substr(username_ptr ->user_string,2,field_length);
        put edit ('status: ',resource_ptr->acr$l_status,' user: ',
                  username)
                 (x(1),a(8),f(10,0),a(6),a);
     end;
  /* print record*/
PRINT:
  bits1to4 = bit(acr$k_print);
  if (andbits = testbits)
     then do;
        put skip edit('PRINT record: ')(a(14));
        print_ctr = print_ctr + 1;
        packet5to7(1) = '000'b;
        packet5to7(2) = '000'b;
        packet1to4(1) = bit(acr$k_id);
        packet1to4(2) = bit(acr$k_print);
        n = 2;
        call copy_packet;
        kid_ptr = p_ptr(1);
        print_ptr = p_ptr(2);
        /* print the name and other information here*/
        put edit ('pid:',kid_ptr->acr$l_pid,'uic:[',kid_ptr -> acr$w_grp,
                  ',',kid_ptr->acr$w_mem,']')
                 (a(4),f(10),x(1),a(5),f(3,0),a(1),f(3,0),a(1));
        put edit ('pages:',print_ptr->acr$l_pagecnt) (x(1),a(6),f(5,0));
     end;
  /* user supplied data record*/
USER:
  bits1to4 = bit(acr$k_user);
  if (andbits = testbits)
     then do;
        put skip list ('USER DATA: ');
        user_ctr = user_ctr + 1;
     end;
  /* accounting file forward link */
ACCTFOR:
  testbits = bit(acr$k_file_fl);
  if (andbits = testbits)
     then do;
        put skip list('ACCTFOR record: ');
        filefl_ctr = filefl_ctr + 1;
     end;
  /* accounting file backward link */
ACCTBAC:
  testbits = bit(acr$k_file_bl);
  if (andbits = testbits)
     then do;
        put skip list('ACCTBAC record: ');
        filebl_ctr = filebl_ctr + 1;
     end;
readit: read file(ACCTG) into(acrv);

end;
close file(ACCTG);

put skip list ('records read: ', record_ctr);
put skip list('Processes deleted: ',prcdel_ctr);
put skip list('images deleted: ',imgdel_ctr);
put skip list('system initialized: ',sysinit_ctr);
put skip list('login validation failed: ',logfail_ctr);
put skip list('print jobs queued: ',print_ctr);
put skip list('User supplied data records: ',user_ctr);
put skip list('ACCTG file forward: ',filefl_ctr);
put skip list('ACCTG file backward: ',filebl_ctr);
put skip list ('***end of processing***');

copy_packet: proc;
/* this routine sets up the pointers to point to its packet,
   while the array of pointers p_type is used in this routine,
   specific pointers such as KID_PTR are set when control is
   returned to the main program, these specific pointers are set
   based on the information returned in P_TYPE */
 dcl i fixed bin(31);
 packet_addr = record_addr + 12;
 do i = 1 to n;
    copy_bits = reverse(packet_ptr -> acr$v_type);
    if copy_bits = p_type (i)
       then do;
         p_addr(i) = packet_addr;
         packet_addr = packet_addr + packet_ptr -> acr$w_length;
       end;
       else put skip list ('***bad packet_type***');
 end;
end copy_packet;
end test;

buy online or call 1.800.AT.COMPAQ