Everhart, Glenn
From:	gartmann@immunbio.mpg.de
Sent:	Monday, September 14, 1998 10:26 AM
To:	Info-VAX@Mvb.Saic.Com
Subject:	Re: Please Respond... Need Help Urgently
In article <ZjNBMpXK9Q$W@usp>, s95007720@student.usp.ac.fj writes:
>Thank you all for your replies to my previous posting. But the suggestions and
>tips that I had received, I had already tried them and they do not tend to meet
>the requirement that I want.
>
>In unix when we use the w command, it lists the users name and the process that
>they are executing. For example
>
>User     tty        from             login@    idle   JCPU   PCPU what
>s6007862 lat/632    LAT_08002BF1D9F0 18:07               7        -csh
>s6007528 lat/634    LAT_08002BF1E121 18:07               5        emacs a2.c
>s5000678 lat/635    LAT_AA0004009004 14:42     3:55               pine
>s5007720 lat/636    LAT_AA0004009004 18:37                        w
>s5007720 lat/638    LAT_AA0004009004 16:32               2        telnet sese
>
>I would like to know if there is any command as such in VAX/VMS. Your help will 
>be most appreciated.

Perhaps you want to try this:


[INHERIT('sys$library:starlet', 'sys$library:pascal$str_routines',
         'sys$library:pascal$sor_routines') ]

PROGRAM image( output );

CONST
   sor$gk_record =  1;                                   {* Record Interface *}
   sor$m_stable  =  1;      {* Bei gleichem Key gilt Reihenfolge der Eingabe *}

TYPE
   t_uword       = [WORD] 0..65535;
   t_item_list_3( smax : INTEGER) =                           {* schema type *}
                   PACKED ARRAY[1..7] OF RECORD
                      buflen : t_uword;
                      itcode : t_uword;
                      bufadr : UNSIGNED;
                      retadr : UNSIGNED;
                   END;
   t_iosb        = [QUAD] RECORD                          {* IO Status Block *}
                      l0, l1 : UNSIGNED;
                   END;
   t_var_string  = VARYING[255] OF CHAR;
   t_string_80   = PACKED ARRAY[1..80] OF CHAR;
   t_key_block   = PACKED RECORD     {* Beschreibung eines Sortierschlüssels *}
                      ktype, korder, koffset, klength : t_uword;
                   END;
   t_key_buf     = PACKED RECORD
                      numkeys : t_uword;                 {* Anzahl Schlüssel *}
                      blocks  : PACKED ARRAY[1..1] OF t_key_block;
                   END;

VAR
   rc, cnt, procnum          : INTEGER;
                             {* Returncode, Schleifenzähler, Anzahl Prozesse *}
   error                     : t_var_string;              {* Fehlernachricht *}
   outstring                 : t_string_80;                  {* Ausgabezeile *}
   key                       : t_key_buf;                {* Sortierschlüssel *}
   piadr                     : UNSIGNED;

                       {* Compiler-Initalisierung *}
                                        {* Interaktiv und Batch, clusterweit *}
   scanlist                  : t_item_list_3( 5 ) :=
                         [ 1 : [ itcode : pscan$_node_csid;
                                 retadr : pscan$m_neq;
                                 OTHERWISE zero ];
                           2 : [ itcode : pscan$_mode;
                                 bufadr : jpi$k_interactive;
                                 retadr : pscan$m_or;
                                 OTHERWISE zero ];
                           3 : [ itcode : pscan$_mode;
                                 bufadr : jpi$k_batch;
                                 OTHERWISE zero ];
                           4 : [ itcode : pscan$_getjpi_buffer_size;
                                 bufadr : 5000;          {* viel hilft viel *}
                                 OTHERWISE zero ]
                           OTHERWISE zero ];

                     {* Image, Prozessname, Username, Terminal, Node und PID *}
   reslist                   : t_item_list_3( 7 ) :=
                         [ 1 : [ itcode : jpi$_imagname;
                                 buflen : 255;
                                 OTHERWISE zero ];
                           2 : [ itcode : jpi$_prcnam;
                                 buflen : 255;
                                 OTHERWISE zero ];
                           3 : [ itcode : jpi$_username;
                                 buflen : 255;
                                 OTHERWISE zero ];
                           4 : [ itcode : jpi$_terminal;
                                 buflen : 255;
                                 OTHERWISE zero ];
                           5 : [ itcode : jpi$_nodename;
                                 buflen : 255;
                                 OTHERWISE zero ];
                           6 : [ itcode : jpi$_pid;
                                 buflen : 4;
                                 OTHERWISE zero ];
                           OTHERWISE zero ];
     
VALUE                                             {* Compiler-Initalisierung *}
   error               := '';
   procnum             :=  0;
   piadr               :=  0;
   key                 := [ numkeys : 1;
                            blocks  : [ 1 : [ korder  :  0;   {* aufsteigend *}
                                              koffset :  1;
                                              klength : 37;
                                              ktype   : dsc$k_dtype_t ] ] ];
                                                                     {* Text *}


FUNCTION f_format_str( string : t_var_string;
                       len    : INTEGER ) : t_var_string;
{*****************************************************************************}
{* Anpassen eines Textstrings auf eine vorgegebene Länge.                    *}
{*****************************************************************************}

BEGIN
   
   IF string.length < len THEN               {* abschneiden oder auffüllen ? *}
      f_format_str := pad( string, ' ', len )   {* auffüllen mit Leerzeichen *}
   ELSE
      f_format_str := substr( string, 1, len );               {* abschneiden *}

END;


PROCEDURE p_read_proc( VAR reslist : t_item_list_3;
                       VAR procnum : INTEGER;
                       VAR piadr   : UNSIGNED;
                       VAR error   : t_var_string );
{*****************************************************************************}
{* Lesen der Daten zu den einzelnen Prozessen.                               *}
{*****************************************************************************}

VAR
   image, procnam, user, help, node, terminal  : t_var_string;
   pid                                         : UNSIGNED;
   iosb                                        : t_iosb;  {* IO Status Block *}
   cnt, rc1, rc2                               : INTEGER;
   outstring                                   : t_string_80;

BEGIN                                                      {* of p_read_proc *}

                                  {* Initialisieren des Puffers mit Adressen *}
   reslist[ 1 ].bufadr := iaddress( image.body );
   reslist[ 1 ].retadr := iaddress( image.length );
   reslist[ 2 ].bufadr := iaddress( procnam.body );
   reslist[ 2 ].retadr := iaddress( procnam.length );
   reslist[ 3 ].bufadr := iaddress( user.body );
   reslist[ 3 ].retadr := iaddress( user.length );
   reslist[ 4 ].bufadr := iaddress( terminal.body );
   reslist[ 4 ].retadr := iaddress( terminal.length );
   reslist[ 5 ].bufadr := iaddress( node.body );
   reslist[ 5 ].retadr := iaddress( node.length );
   reslist[ 6 ].bufadr := iaddress( pid );

   REPEAT
      rc1 := $getjpiw( , piadr,, reslist, iosb );  {* nächsten Prozess lesen *}
      IF iosb.l0 = ss$_normal THEN BEGIN
         node     := f_format_str( node, 7 );
         procnam  := f_format_str( procnam, 16 );
         terminal := f_format_str( terminal, 9 );
         procnum := procnum + 1;

                   {* Directory und Versionsnummer vom Imagename abschneiden *}
         cnt := index( image, ']') + 1;
         REPEAT
            rc2 := str$right( %DESCR help, image, cnt );
            cnt := index( help, ']') + 1;
            image := help;
         UNTIL cnt < 2; 
         cnt := index( image, ';') - 1;
         IF cnt > 2 THEN rc2 := str$left( %DESCR image, help, cnt );
         IF image = '' THEN image := '(DCL)';

                                {* Formatieren, Übergabe des Records an SORT *}
         outstring := f_format_str(' ' + user + '  ' + node + procnam +
                             terminal + hex( pid ) + '  ' + image, 80 );
         rc2 := sor$release_rec( outstring, );
      END;
   UNTIL ( rc1 <> ss$_normal ) AND ( rc1 <> ss$_suspended );
                                  {* bis Fehler oder keine weiteren Prozesse *}
   IF rc1 <> ss$_nomoreproc THEN                       {* also echter Fehler *}
      error := 'Error accessing process information! RC=' + dec( rc1 );

END;                                                       {* of p_read_proc *}


BEGIN                                                     {* of main program *}

   writeln;
   rc := $process_scan( piadr, scanlist );      {* Suchkontext initalisieren *}
   IF rc = ss$_normal THEN BEGIN
                                            {* Sortiervorgang initialisieren *}
      rc := sor$begin_sort( key, 80, sor$m_stable,,,, sor$gk_record,, );
      p_read_proc( reslist, procnum, piadr, error );          {* Daten lesen *}
      IF error.length = 0 THEN BEGIN
         rc := sor$sort_merge( );                  {* Sortiervorgang starten *}

         write( ' Username      Node   Process Name    Terminal  PID');
         writeln('       Image');
         FOR cnt := 1 TO procnum DO BEGIN  {* Ausgabe der sortierten Records *}
            rc := sor$return_rec( outstring,, );
            writeln( outstring );
         END;
         rc := sor$end_sort( );                                 {* aufräumen *}
      END;
   END
   ELSE error := ' Error accessing processes! RC=' + dec( rc );
   writeln( error );                         {* Leerzeile oder Fehlermeldung *}

END.                                                      {* of main program *}



Regards,
   Christoph Gartmann

+----------------------------------------------------------------------------+
| Max-Planck-Institut fuer      Phone   : +49-761-5108-464   Fax: -452       |
| Immunbiologie                                                              |
| Postfach 1169                 Internet: gartmann@immunbio.mpg.de           |
| D-79011  Freiburg, FRG                                                     |
+----------- Do you know MENUE, the user environment for OpenVMS? -----------+