Home page  Up a level  RPG IV APIs  CL Menu  Display File Fields  Small Calendar 

RPG IV APIs

 

Table of contents:

WDWTITLE - Window Titles in Display Files
QUSRJOBI - Retrieve job attributes API
QUSROBJD - Retrieve object description API
QWCRSVL - Retrieve system value API


WDWTITLE - Window Title Definition


WDWTITLE([title-text] [title-text-color]
[title-text-display-attribute]
[*CENTER | *LEFT | *RIGHT]
[*TOP | *BOTTOM])

You can specify more than one WDWTITLE on a record. If you specify the WDWTITLE keyword more than once at the record level, the parameters for the keywords that are in effect are combined. If different values are specified for the same parameter, the parameter value of the first keyword is used

 


QUSRJOBI - Retrieve job attributes API


 

This code will retrieve the user part of the current library list,

This is the prototype for the API:

***
*** Retrieve the current user library list.
***
D RtvJobApi PR ExtPgm('QUSRJOBI')
D 32767
D 10I 0
D 8
D 26
D 16
D 272

This is the receiver variable definition:

D p@Receiver DS 32767
D 64 Inz(*Blanks)
D p@NbrSysLibs 10I 0
D p@NbrPrdLibs 10I 0
D p@NbrCurLibs 10I 0
D p@NbrUsrLibs 10I 0

This is the error data structure for the API - it is listed above in the prototype with a length of 272.

***
*** API error data structure.
***
D APIErrorDS DS
D BytesProvided 10I 0 Inz(%Size(APIErrorDS))
D BytesAvail 10I 0 Inz(*Zeros)
D MsgID 7 Inz(*Blanks)
D Reserved 1 Inz(X'00')
D MsgDta 256 Inz(*Blanks)

Here are the work fields defined:

D w@Format S 8 Inz('JOBI0700')
D w@QualJobName S 26 Inz('*')
D w@IntJobID S 16
D w@UsrLibs S 2670
D w@LibsToSkip S 10I 0

This is the code in free-format RPG:

/Free
  //** Get the entire library list.
  RtvJobApi(p@Receiver : w@RcvVarLen : w@Format : w@QualJobName
           : w@IntJobID : APIErrorDS);

  //** Count the system libraries, product libraries and current library.
  w@LibsToSkip = p@NbrSysLibs + p@NbrPrdLibs + p@NbrCurLibs;

  //** Skip the system libraries, product libraries and current library.
  X = (w@LibsToSkip * 11) + 81;

  //** Get the user libraries from the calculated offset.
  w@UsrLibs = %Subst(p@Receiver : X : p@NbrUsrLibs * 11);

/End-free

 


QUSROBJD - Retrieve Object Description API


 

This API will show how to get the library for an object, as well as the object's text.  The object must be in your library list in order for this to work.

***
*** Get the object description.
***
D pRtvObjLib PR ExtPgm('QUSROBJD')
D p@Receiver 134
D p@RcvLength 4B 0
D p@Format 8
D p@ObjLib 20
D p@ObjType 10
D p@ErrorDS 272

This is the receiver variable for the object description. This only includes the OBJD0100 and OBJD0200 formats. You can also include the OBJB0300 and OBJD0400 formats which are located here.  If you do add them, you will have to increase the size of the receiver variable in the API prototype above.

***
*** QUSROBJD retrieve object description receiver.
***
D p@Receiver1 DS
D p@BytesReturn 4B 0
D p@BytesAvail 4B 0
D p@Reserved1 4B 0
D p@Reserved2 4B 0
D p@ObjName 10
D p@LibName 10
D p@ObjType 10
D p@RetLib 10
D p@AuxStgPool 4B 0
D p@Reserved3 4B 0
D p@ObjOwner 10
D p@ObjDomain 2
D p@CrtDteTime 13
D p@ChgDteTime 13
D p@ExtObjAttr 10
D p@Text 50
D p@SrcFilName 10
D p@SrcFilLib 10
D p@SrcMbrNam 10

***
*** API error data structure.
***
D APIErrorDS DS
D BytesProvided 10I 0 Inz(%Size(APIErrorDS))
D BytesAvail 10I 0 Inz(*Zeros)
D MsgID 7 Inz(*Blanks)
D Reserved 1 Inz(X'00')
D MsgDta 256 Inz(*Blanks)

***
*** Work fields
***
D w@Library S 10
D w@ObjLib S 20
D w@RcvVarLen S 10I 0 Inz(%Len(p@Receiver))
D w@RcvLength S 4B 0 Inz(%Len(p@Receiver1))
D w@Format S 8 Inz('JOBI0700')

This shows the code, in Free Form RPG, to get the object information:

//** Set w@ObjLib to the objectname + libraryname
w@ObjLib = %Subst(objectname : 1 : 10) + libraryname;
w@RcvLength = %Len(p@Receiver1);
w@Format = 'OBJD0200';

Reset APIErrorDS;

pRtvObjLib(p@Receiver1 : w@RcvLength : w@Format : w@ObjLib
: whoTyp : APIErrorDS);
If p@RetLib <> *Blanks;
whlnam = p@RetLib;
Update qwhdrppr;
EndIf;

 


QWCRSVAL - Retrieve System Value API


This API will let you retrieve a system value into your RPG program.  I created a service program to do this so this is the entire program.  Use CRTRPGMOD to create the module, then CRTSRVPGM to create the service program.

H NoMain
**************************************************************************
*** NAME: gRtvSysVal                                                   ***
*** TYPE: Service Program                                              ***
*** DESCRIPTION: Retrieve a system value that is passed in.            ***
***                                                                    ***
*** Copyright 2002 by John H. Daily III                                ***
**************************************************************************
*** Special instructions:
*** Use CRTRPGMOD to create the module, then CRTSRVPGM to create the
*** service program.
**************************************************************************
***                  ��� SUBPROCEDURE PROTOTYPES ���                   ***
**************************************************************************
***
*** Retrieve a system value.
***
D gRtvSysVal PR 256
D p@SysVal 10
D p@DataLength 10I 0
D 272 Options( *NoPass )

***
*** Retrieve System Value
***
D RtvSysVal PR ExtPgm('QWCRSVAL')
D 3008
D 10I 0
D 10I 0
D 10
D 272

**************************************************************************
*** Subprocedure: Retrieve a system value that is passed in.           ***
*** gRtvSysVal                                                         ***
**************************************************************************
P gRtvSysVal B Export
D PI 256
D p@SysVal 10
D p@DataLength 10I 0
D APIError 272 Options( *NoPass )

**************************************************************************
***                  ��� INTERNAL DATA STRUCTURES ���                  ***
**************************************************************************
***
*** Receiver variable
***
D RcvVar DS 3008
D NbrValsRtn 10I 0
D OffsetToVals 10I 0
D RcvValue 3000

***
*** System value information.
***
D SysValInfo DS
D RtnSysVal 10
D DataType 1
D Status 1
D DataLen 10I 0
D SysValue 256

***
*** API error data structure.
***
D APIErrorDS DS
D BytesProvided 10I 0 Inz(%Size(APIErrorDS))
D BytesAvail 10I 0 Inz(*Zero)
D MsgID 7 Inz(*Blanks)
D Reserved 1 Inz(X'00')
D MsgDta 256 Inz(*Blanks)

**************************************************************************
***                      ��� WORK FIELDS ���                           ***
**************************************************************************
D Pos S 10I 0
D w@Length S 10I 0
D RcvVarLen S 10I 0 Inz(%Len(RcvVar))
D NbrToRtv S 10I 0 Inz(1)
D SysVal S 10
D SystemValue S 256
D APIErrorPassed S 1N

**************************************************************************
***                        ��� CONSTANTS ���                           ***
**************************************************************************
D NoAPIError C Const(0)

**************************************************************************
***           ��� CALCULATION SPECIFICATIONS ���                       ***
**************************************************************************

/Free

  //** Move the system value to be retrieved into the data structure.
  SysVal = p@SysVal;

  //** Determine whether API error parameter was passed.
  If %Parms > 1;
    APIErrorPassed = *ON;
  EndIf;

  //** Retrieve the system value.
  Reset APIErrorDS;
  Callp RtvSysVal(RcvVar : RcvVarLen : NbrToRtv : Sysval : APIErrorDS);

  If BytesAvail <> NoAPIError;
    Exsr ReturnError;
  EndIf;

  Pos = OffsetToVals + 1;
  w@Length = %Len(RcvVar) - Pos;

  SysValInfo = %Subst(RcvVar : Pos : w@Length);
  If Status <> ' ';
    Exsr ReturnError;
  EndIf;

  p@DataLength = DataLen;
  Return SysValue;
  *INLR = *ON;

  //**********************************************************************
  //** SUBROUTINE: Return an error to the calling routine.             ***
  //** ReturnError                                                     ***
  //**********************************************************************
  Begsr ReturnError;

    //** If the parm for the api error was passed, return the error.
    If APIErrorPassed;
      APIError = APIErrorDS;
    EndIf;

    Return *Blank;

  EndSr;

/End-Free

P gRtvSysVal E