RPGIV @ Work

A unique site for RPG and System i Lovers


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

Blog - Content Section Layout
User Rating: / 0
Written by Chamara   
dGetLstSplFID     pr                  extpgm('QSPRILSP')           
d RcvVar                         1    options(*varsize)            
d LenRcvVar                     10i 0 const                        
d FmtRcvVar                      8    const                        
d QUSEC                               likeds(QUSEC)                                                                                

dWait             s              1                                  
 /copy qsysinc/qrpglesrc,qsprilsp                                  
 /copy qsysinc/qrpglesrc,qusec                                     
  QUSBPrv = 0;                                                   
  GetLstSplFID(QSPL0100 :%size(QSPL0100) :'SPRL0100' :QUSEC); 

  dsply ('Last file created is: ' + QSPSN03);                       
  dsply (' for job ' + %trimr(QSPJN00) + '/' +                     
          %trimr(QSPUN00) + '/' + QSPJNBR00);                      
  dsply (' Spool file number is ' + %char(QSPSNBR03)) ' ' Wait;              

  *inlr = *on;                                                     

Write Comment (0 comments)
User Rating: / 0
Written by Chamara Withanachchi   
     H dftactgrp(*no) actgrp(*caller)                                      
     D DBOP0100        DS                  qualified                       
     D  HeaderSize                   10i 0                                 
     D  FormatName                    8                                    
     D  ArrayOffset                  10i 0                                 
     D  FileCount                    10i 0                                 
     D  ElementLength                10i 0                                 
     D  JobName                      10                                    
     D  UserName                     10                                    
     D  JobNumber                     6                                    
     D  CurrentUser                  10                                    
     D  QueryOpen                     1                                    
     D DBOPFile        DS                  qualified Based(DBOPFilePtr)    
     D  FileName                     10                                    
     D  Library                      10                                    
     D  Member                       10                                    
     D                                2                                
     D  FileType                     10i 0                             
     D  UnderlyingPF                 10i 0                             
     D  InputOption                   1                                
     D  OutputOption                  1                                
     D  UpdateOption                  1                                
     D  DeleteOption                  1                                
     D returnCode      S             10i 0                             
     D i               S             10i 0                             
     D userNam         S                   Like(DBOP0100.UserName)     
     D fileNam         S                   Like(DBOPFile.fileName)     
     D librNam         S                   Like(DBOPFile.Library)      
     D curUser         S                   Like(DBOP0100.currentUser)  
     D cmd             S                   Like(StdCmd)                
     D len             S                   Like(stdLen)                
     D                                     Inz(%size(cmd))             
     D StdCmd          S            250A                               
     D StdLen          S             15P 5                        
     D Execute         PR                  ExtPgm('QCMDEXC')      
     D     CmdStr                          Like(StdCmd)           
     D                                     Options(*VarSize)      
     D                                     Const                  
     D     CmdStrLen                       Like(StdLen) Const     
     D DB_Open         PR                  ExtPgm('DBOPEN')       
     D  DBOP01001                          Like(DBOP0100)         
     D  ReturnCode1                        Like(ReturnCode)       
     D DB_Open         PI                                         
     D  DBOP01001                          Like(DBOP0100)         
     D  ReturnCode1                        Like(ReturnCode)       

          // Extract current user from passed in structure           
          curUser = DBOP0100.CurrentUser;                            
          returnCode = 1;                                            
          // Process each table being opened by the request          
          For i = 1 to DBOP0100.FileCount;                           
             DBOPFilePtr = %Addr(DBOP0100) + DBOP0100.ArrayOffset +  
                           (i - 1) * DBOP0100.ElementLength;         
             FileNam = dbopFile.FileName;                            
             //If My File in my lib Opens                            
             If fileNam = 'PEMPMAS' and librNam = 'INACPAYD10';      
                cmd = 'SNDMSG MSG(''''PEMPMAS open from ' +          
                      'INACPAYD10 Library'''') TOUSR(*SYSOPR)';      
                Execute(cmd : len);                                  

Write Comment (0 comments)
Track Previous Image of User Profile
User Rating: / 0
Written by Chamara Withanachchi   
/* Author : Chamara Withanachchi                       */    
/* Use WRKREGINF command to register this exit program */    
/* QIBM_QSY_CHG_PROFILE format : CHGP0200              */    
    PGM        PARM(&PRFDTA)                                 
    DCL        VAR(&PRFDTA) TYPE(*CHAR) STG(*AUTO) LEN(40)   
    DCL        VAR(&EXITPGMN) TYPE(*CHAR) LEN(10)            
    DCL        VAR(&EXITFMT) TYPE(*CHAR) LEN(8)              
    DCL        VAR(&USRPRF) TYPE(*CHAR) LEN(10)              
    DCL        VAR(&SPCLA) TYPE(*CHAR) LEN(100)              
    DCL        VAR(&USRCLS) TYPE(*CHAR) LEN(10)              
    DCL        VAR(&FULLDTA) TYPE(*CHAR) LEN(200)            
    CHGVAR     VAR(&USRPRF) VALUE(%SST(&PRFDTA 29 10))       
    /* GET THE DETAILS IN TO A SINGLE STRING  */             
    CHGVAR     VAR(&FULLDTA) VALUE('B ' *CAT &SPCLA)         
    /* Write back to QAUDJRN Before Image of the User Profile */ 
Write Comment (0 comments)
User Rating: / 0
Written by Chamara Withanachchi   

Teraspace is a large temporary space that is local to a job. A teraspace provides a contiguous address space but may consist of many individually allocated areas, with unallocated areas in between. Teraspace exists no longer than the time between job start and job end.

A teraspace is not a space object. This means that it is not a system object, and that you cannot refer to it by using a system pointer. However, teraspace is addressable with space pointers.

The following table shows how teraspace compares to single-level store.

Attributes Teraspace Single-level store
Locality Process local: normally accessible only to the owning job. Global: accessible to any job that has a pointer to it.
Size 1 TB total Many 16 MB units.
Supports memory mapping? Yes No
Addressed by 8-byte pointers? Yes No
Supports sharing between jobs? Must be done using shared memory APIs (for example, shmat or mmap). Can be done by passing pointers to other jobs or using shared memory APIs.

ILE programs use single-level store by default. In order to process teraspace addresses, a program must be teraspace enabled. Teraspace-enabled programs can process a teraspace address in a variety of contexts, for example:

  • When it is returned from a request to allocate teraspace heap storage
  • When it is returned from a request to allocate teraspace shared memory
  • When it is passed in from another program.

The following compilers generate teraspace-enabled code:

  • ILE C (choose TERASPACE(*YES) when you create modules and programs)
  • ILE C++ (choose TERASPACE(*YES) when you create modules and programs)
  • ILE RPG (teraspace-enabled is the default beginning with V4R4)
  • ILE COBOL (teraspace-enabled is the default beginning with V4R4)
  • ILE CL (teraspace-enabled is the default beginning with V5R1)

The ILE C and C++ compilers provide the TERASPACE (*YES *TSIFC) create command option to allow the use of teraspace versions of storage interfaces without source code changes. For example, malloc() is mapped to _C_TS_malloc().

QSYGETPH (Get Profile Handle) API and QWTSETP (Set Profile Handle)
User Rating: / 0
Written by Chamara Withanachchi   

QSYGETPH - Get Profile Handle

The Get Profile Handle API validates user IDs and passwords and creates a profile handle for use in jobs that run under more than one user profile. The profile handle is temporary; you can use it only in the job that created it.

QWTSETP - Set Profile Handle

The Set Profile Handle API validates the profile handle, locks the user profile, and changes the current thread to run under the user and group profiles represented by the profile handle. Once the change has been made, any open files and objects allocated by the original profile are accessible to the new profile.

h dftactgrp(*NO) bnddir('QC2LE')                                       
d ProgStatus     sds                                                   
d  Parms            *PARMS                                             
d  ProgName         *PROC                                              
d  ErrMsgID              40     46                                     
d  ErrMsg                91    169                                     
d  JobName              244    253                                     
d  UserId               254    263                                     
d  JobNumber            264    269                                     
d MyProgram       PR                  ExtPgm('MYPROGRAM')                 
d GetUserProfile  PR                  ExtPgm('QSYGETPH')               
d  $userID                      10A   const                            
d  $password                    10A   const                            
d  $handle                      12A                                    
d  $errorCode                32766A   options(*varsize: *nopass)       
d  $length                      10I 0 const options(*nopass)           
d  $ccsid                       10I 0 const options(*nopass)           
d SetUserProfile  PR                  ExtPgm('QWTSETP')                
d  $handle                      12A   const                            
d  $errorCode                32766A   options(*varsize: *nopass)  
d ErrorDS         DS                                              
d  $bytesPrv              1      4I 0 INZ(256)                    
d  $bytesAvl              5      8I 0 INZ(0)                      
d  $errMsgID              9     15                                
d  $reserved             16     16                                
d  $errMsgDta            17    256                                
d  curHandle      s             12a                               
d  newHandle      s             12a                               
d  nUserId        s             10a   inz('VAI')                  
d  nPassword      s             10a   inz('VAI9')                 
d  length         s              4B 0 inz(10)                     
d  ccsid          s              4B 0 inz(37)                     
   //Get handle on the current user profile, password not needed                                                              
   GetUserprofile(UserId: '*NOPWDCHK': curHandle: ErrorDS);       
   if $bytesAvl > 0;                                              
     //Get hanlde on the new user profile, password is needed here                            
     if $bytesAvl > 0;                     
       //Switch to new user profile  
       SetUserProfile(newHandle: ErrorDs); 
       if $bytesAvl > 0;                   
   //Change this to your own program call
         //Set the user profile back to the original user                   
         SetUserProfile(curHandle: ErrorDs);
         if $bytesAvl > 0;                 
   eval *inlr = *on;  
<< Start < Previous 1 2 3 4 5 6 7 8 9 10 Next > End >>

Results 31 - 40 of 626