RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

List and enable disabled NetServer users Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   

Sample from Jamie Flanary (www.code400.com)


      **  Compile options:                                                                          
      **                                                                                            
      **    CrtRpgMod Module( CBX110 )  DbgView( *LIST )                                            
      **                                                                                            
      **    CrtPgm    Pgm( CBX110 )                                                                 
      **              Module( CBX110 )                                                              
      **                                                                                            
      **                                                                                            
      **-- Header specifications:  --------------------------------------------**                   
     H Option( *SrcStmt )                                                                           
      **-- API error data structure:                                                                
     D ERRC0100        Ds                  Qualified                                                
     D  BytPrv                       10i 0 Inz( %Size( ERRC0100 ))                                  
     D  BytAvl                       10i 0                                                          
     D  MsgId                         7a                                                            
     D                                1a                                                            
     D  MsgDta                      256a                                                            
                                                                                                    
     **-- Global constants:                                                                         
     D OFS_MSGDTA      c                   16                                                       
     **-- Global variables:                                                                         
     D Idx             s             10i 0                                                          
     D MsgRpy          s             32a   Varying                                                  
     D NetSvrUsr       s             10a   Varying                                                  
                                                                                                    
     **-- API parameters:                                                                           
     D ZLSL0900        Ds                  Qualified                                                
     D  DsaNetUsr                    10a   Dim( 1024 )                                              
     **-- List information:                                                                         
     D LstInf          Ds                  Qualified                                                
     D  RcdNbrTot                    10i 0                                                          
     D  RcdNbrRtn                    10i 0                                                          
     D  RcdLen                       10i 0                                                          
     D  InfLenRtn                    10i 0                                                          
     D  InfCmp                        1a                                                            
     D  Dts                          13a                                                            
     D                               34a                                                            
     **-- Request variable:                                                                         
     D ZLSS0200        Ds                  Qualified                                                
     D  NbrSvrUsr                    10i 0                                                          
     D  NetSvrUsr                    10a   Dim( 1024 )                                              
                                                                                                    
     **-- Open list of server information:                                                          
     D LstSvrInf       Pr                  ExtPgm( 'QZLSOLST' )                                     
     D  LsRcvVar                  32767a          Options( *VarSize )                               
     D  LsRcvVarLen                  10i 0 Const                                                    
     D  LsLstInf                     64a                                                            
     D  LsFmtNam                     10a   Const                                                    
     D  LsInfQual                    15a   Const                                                    
     D  LsError                   32767a          Options( *VarSize )                               
     **                                                                                             
     D  SiSsnUsr                     10a   Const  Options( *NoPass )                                
     **                                                                                             
     D  SiSsnId                      20i 0 Const  Options( *NoPass )                                
     **-- Change server information:                                                                
     D ChgSvrInf       Pr                  ExtPgm( 'QZLSCHSI' )                                     
     D  CsRqsVar                  32767a   Const  Options( *VarSize )                               
     D  CsRqsVarLen                  10i 0 Const                                                    
     D  CsFmtNam                     10a   Const                                                    
     D  CsError                   32767a          Options( *VarSize )                               
     **-- Send program message:                                                                     
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )                                     
     D  SpMsgId                       7a   Const                                                    
     D  SpMsgFq                      20a   Const                                                    
     D  SpMsgDta                    512a   Const  Options( *VarSize )                               
     D  SpMsgDtaLen                  10i 0 Const                                                    
     D  SpMsgTyp                     10a   Const                                                    
     D  SpCalStkE                    10a   Const  Options( *VarSize )                               
     D  SpCalStkCtr                  10i 0 Const                                                    
     D  SpMsgKey                      4a                                                            
     D  SpError                     512a          Options( *VarSize )                               
     **                                                                                             
     D  SpCalStkElen                 10i 0 Const  Options( *NoPass )                                
     D  SpCalStkEq                   20a   Const  Options( *NoPass )                                
     D  SpDspWait                    10i 0 Const  Options( *NoPass )                                
     **                                                                                             
     D  SpCalStkEtyp                 20a   Const  Options( *NoPass )                                
     D  SpCcsId                      10i 0 Const  Options( *NoPass )                                
     **-- Receive program message:                                                                  
     D RcvPgmMsg       Pr                  ExtPgm( 'QMHRCVPM' )                                     
     D  RpRcvVar                  32767a          Options( *VarSize )                               
     D  RpRcvVarLen                  10i 0 Const                                                    
     D  RpFmtNam                     10a   Const                                                    
     D  RpCalStkE                   256a   Const  Options( *VarSize )                               
     D  RpCalStkCtr                  10i 0 Const                                                    
     D  RpMsgTyp                     10a   Const                                                    
     D  RpMsgKey                      4a   Const                                                    
     D  RpWait                       10i 0 Const                                                    
     D  RpMsgAct                     10a   Const                                                    
     D  RpError                   32767a          Options( *VarSize )                               
     **                                                                                             
     D  RpCalStkElen                 10i 0 Const  Options( *NoPass )            call stack counter  
     D  RpCalStkEq                   20a   Const  Options( *NoPass )            call stack counter  
     **                                                                                             
     D  RpCalStkEtyp                 20a   Const  Options( *NoPass )            call stack counter  
     D  RpCcsId                      10i 0 Const  Options( *NoPass )            call stack counter  
     **-- Get inquiry message reply:                                                                
     D GetInqRpy       Pr           128a   Varying                                                  
     D  PxMsgDta                    512a   Const  Varying                                           
     **-- Send completion message:                                                                  
     D SndCmpMsg       Pr            10i 0                                                          
     D  PxMsgDta                    512a   Const  Varying                                           
     **-- Send escape message:                                                                      
     D SndEscMsg       Pr            10i 0                                                          
     D  PxMsgId                       7a   Const                                                    
     D  PxMsgF                       10a   Const                                                    
     D  PxMsgDta                    512a   Const  Varying                                           
                                                                                                    
      /Free                                                                                         
                                                                                                    
        LstSvrInf( ZLSL0900                                                                         
                 : %Size( ZLSL0900 )                                                                
                 : LstInf                                                                           
                 : 'ZLSL0900'                                                                       
                 : *Blank                                                                           
                 : ERRC0100                                                                         
                 );                                                                                 
                                                                                                    
           If  ERRC0100.BytAvl > *Zero;                                                             
               SndEscMsg( ERRC0100.MsgId                                                            
                  : 'QCPFMSG'                                                                       
                   : %Subst( ERRC0100.MsgDta: 1: ERRC0100.BytAvl - OFS_MSGDTA )                     
                  );                                                                                
                                                                                                    
             ElseIf  LstInf.InfCmp = 'C';                                                           
                                                                                                    
             For Idx = 1  to LstInf.RcdNbrTot;                                                      
                                                                                                    
             ExSr  PrcLstEnt;                                                                       
             EndFor;                                                                                
        EndIf;                                                                                      
                                                                                                    
        SndCmpMsg( 'NetServer user activation completed.' );                                        
                                                                                                    
         Return;                                                                                    
                                                                                                    
         BegSr  PrcLstEnt;                                                                          
                                                                                                    
          NetSvrUsr = %TrimR( ZLSL0900.DsaNetUsr(Idx) );                                            
                                                                                                    
         MsgRpy = GetInqRpy( 'NetServer user ' + NetSvrUsr +                                        
                         ' disabled. Enable NetServer user (Y=Yes)?'                                
                       );                                                                           
                                                                                                    
           If  %Xlate( 'y':'Y': MsgRpy ) = 'Y';                                                     
                                                                                                    
            ZLSS0200.NbrSvrUsr  = 1;                                                                
            ZLSS0200.NetSvrUsr(1) = NetSvrUsr;                                                      
                                                                                                    
            ChgSvrInf( ZLSS0200: %Size( ZLSS0200 ): 'ZLSS0200': ERRC0100 );                         
                                                                                                    
            If  ERRC0100.BytAvl > *Zero;                                                            
                                                                                                    
             If  ERRC0100.BytAvl < OFS_MSGDTA;                                                      
               ERRC0100.BytAvl = OFS_MSGDTA;                                                        
             EndIf;                                                                                 
                                                                                                    
             SndEscMsg( ERRC0100.MsgId                                                              
                     : 'QCPFMSG'                                                                    
                      : %Subst( ERRC0100.MsgDta                                                     
                            : 1                                                                     
                            : ERRC0100.BytAvl - OFS_MSGDTA                                          
                            )                                                                       
                     );                                                                             
            Else;                                                                                   
              SndCmpMsg( 'NetServer user ' + NetSvrUsr + ' enabled.' );                             
            EndIf;                                                                                  
          EndIf;                                                                                    
                                                                                                    
        EndSr;                                                                                      
                                                                                                    
       /End-Free                                                                                    
                                                                                                    
     **-- Get inquiry message reply:  ----------------------------------------**                    
     P GetInqRpy       B                                                                            
     D                 Pi           128a   Varying                                                  
     D  PxMsgDta                    512a   Const  Varying                                           
     **                                                                                             
     D MsgKey          s              4a                                                            
     **-- Message information structure:                                                            
     D RCVM0100        Ds                  Qualified                                                
     D  BytPrv                       10i 0                                                          
     D  BytAvl                       10i 0                                                          
     D  MsgSev                       10i 0                                                          
     D  MsgId                         7a                                                            
     D  MsgTyp                        2a                                                            
     D  MsgKey                        4a                                                            
     D                                7a                                                            
     D  CcsIdCnvSts                  10i 0                                                          
     D  CcsIdDta                     10i 0                                                          
     D  MsgLenRtn                    10i 0                                                          
     D  MsgLenAvl                    10i 0                                                          
     D  MsgRpy                       32a                                                            
                                                                                                    
      /Free                                                                                         
                                                                                                    
        SndPgmMsg( *Blanks                                                                          
                 : *Blanks                                                                          
                 : PxMsgDta                                                                         
                 : %Len( PxMsgDta )                                                                 
                 : '*INQ'                                                                           
                 : '*EXT'                                                                           
                 : *Zero                                                                            
                 : MsgKey                                                                           
                 : ERRC0100                                                                         
                  );                                                                                
                                                                                                    
         RcvPgmMsg( RCVM0100                                                                        
                 : %Size( RCVM0100 )                                                                
                 : 'RCVM0100'                                                                       
                 : '*'                                                                              
                 : *Zero                                                                            
                 : '*RPY'                                                                           
                 : MsgKey                                                                           
                 : -1                                                                               
                 : '*OLD'                                                                           
                 : ERRC0100                                                                         
                 );                                                                                 
                                                                                                    
         Return  %Subst( RCVM0100.MsgRpy: 1: RCVM0100.MsgLenRtn );                                  
                                                                                                    
      /End-Free                                                                                     
                                                                                                    
     P GetInqRpy       E                                                                            
     **-- Send completion message:  ------------------------------------------**                    
     P SndCmpMsg       B                                                                            
     D                 Pi            10i 0                                                          
     D  PxMsgDta                    512a   Const  Varying                                           
     **                                                                                             
     D MsgKey          s              4a                                                            
                                                                                                    
      /Free                                                                                         
                                                                                                    
        SndPgmMsg( 'CPF9897'                                                                        
                 : 'QCPFMSG   *LIBL'                                                                
                 : PxMsgDta                                                                         
                 : %Len( PxMsgDta )                                                                 
                 : '*COMP'                                                                          
                 : '*PGMBDY'                                                                        
                 : 1                                                                                
                 : MsgKey                                                                           
                 : ERRC0100                                                                         
                 );                                                                                 
                                                                                                    
        If  ERRC0100.BytAvl > *Zero;                                                                
          Return  -1;                                                                               
                                                                                                    
        Else;                                                                                       
         Return  0;                                                                                 
                                                                                                    
        EndIf;                                                                                      
                                                                                                    
      /End-Free                                                                                     
                                                                                                    
     P SndCmpMsg       E                                                                            
     **-- Send escape message:  ----------------------------------------------**                    
     P SndEscMsg       B                                                                            
     D                 Pi            10i 0                                                          
     D  PxMsgId                       7a   Const                                                    
     D  PxMsgF                       10a   Const                                                    
     D  PxMsgDta                    512a   Const  Varying                                           
     **                                                                                             
     D MsgKey          s              4a                                                            
                                                                                                    
      /Free                                                                                         
                                                                                                    
        SndPgmMsg( PxMsgId                                                                          
                 : PxMsgF + '*LIBL'                                                                 
                 : PxMsgDta                                                                         
                 : %Len( PxMsgDta )                                                                 
                 : '*ESCAPE'                                                                        
            : '*PGMBDY'                                                                             
            : 1                                                                                     
            : MsgKey                                                                                
            : ERRC0100                                                                              
            );                                                                                      
                                                                                                    
        If  ERRC0100.BytAvl > *Zero;                                                                
          Return  -1;                                                                               
                                                                                                    
        Else;                                                                                       
         Return   0;                                                                                
        EndIf;                                                                                      
                                                                                                    
      /End-Free                                                                                     
                                                                                                    
     P SndEscMsg       E  

User Comments

Please login or register to add comments

<Previous   Next>