Warning: Declaration of TCB_Menu_Walker::walk($elements, $max_depth) should be compatible with Walker::walk($elements, $max_depth, ...$args) in /home/nicklit/www/www/wp-content/plugins/thrive-visual-editor/inc/classes/class-tcb-menu-walker.php on line 620

Warning: session_start(): Cannot start session when headers already sent in /home/nicklit/www/www/wp-content/plugins/userpro/includes/class-userpro.php on line 222
Modernize RPG code for 'Get the System Name' for IBM i, iSeries and AS400 - Nick Litten is IBM-i, AS400 iSeries RPG Programmer and Nerd

Modernize RPG code for ‘Get the System Name’ for IBM i, iSeries and AS400

IBM i

Jan 26

For any RPG programmer, writing RPGLE code (sometimes called RPG4) is fun. But, upgrading older RPG programs to the latest free form program layout is even more fun! The joy experienced when the Project is to “Modernize RPG” always puts an inane grin on my face.

So lets look at a simple example:

Get Sysname using IBM API written in iSERIES style RPGLE

Modernize RPG
// Prototype for the Rtvsysname function D RtvSysName PR 8A // Variable that will hold the system name D MYSYSTEM S 8A // simply add this line of code to get the system name C eval MYSYSTEM = RtvSysName() C mysystem dsply(e) C eval *inlr = *on // Retrieve System Name Subprocedure P RtvSysName B Export D RtvSysName PI 8A D QWCRNETA PR ExtPgm('QWCRNETA') D RcvVar 32766A OPTIONS(*VARSIZE) D RcvVarLen 10I 0 const D NbrNetAtr 10I 0 const D AttrNames 10A const D ErrorCode 256A // Error code structure D apiError DS 256 // Receiver variable for QWCRNETA D apiData ds D Filler 32A D RtnSystem 8A // Call the *API and return the system name C callp QWCRNETA (apiData : C %size(apiData) : C 1 : C 'SYSNAME' : C apiError ) C return RtnSystem P E

 

Lets put on our RPG MODERNIZER hat

and here you have the same code in free format style RPGLE (which I much prefer)

// Prototype for the Rtvsysname function
ctl-opt expropts(*resdecpos) option(*nodebugio: *nounref)
dftactgrp(*no) actgrp(*caller) datfmt(*iso) timfmt(*iso);

// Global Variable that will hold the system name
dcl-s MYSYSTEM char(8);

// simply add this line of code to get the system name
MYSYSTEM = RtvSysName();
dsply(e) mysystem;
*inlr = *on;
return;

// Retrieve System Name Subprocedure
dcl-proc RtvSysName export;
dcl-pi RtvSysName char(8) end-pi;
dcl-pr QWCRNETA extpgm('QWCRNETA');
 *n char(32766) options(*varsize); // RcvVar
 *n int(10) const; // RcvVarLen
 *n int(10) const; // NbrNetAtr
 *n char(10) const; // AttrNames
 *n char(256); // ErrorCode
end-pr;

// Error code structure
dcl-ds apiError len(256) end-ds;

// Receiver variable for QWCRNETA
dcl-ds apiData;
 Filler char(32);
 RtnSystem char(8);
end-ds;

// Call the *API and return the system name
QWCRNETA(apiData :
         %size(apiData) :
         1 :
         'SYSNAME' :
         apiError );

return RtnSystem;
end-proc;

Come’on – look at how beautiful that is!

note: All code converted automatically using the free command UPGRPGSRC from the Projex4i Toolkit.

Imagine what the old AS400 programmers would think if they came out of retirement and saw this modern IBM i language code?

/me puts on his flame-retardent underpants 😉

Follow

About the Author

IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Alpha Nerd and Passionate Eater of Cheese and Biscuits. Nick Litten Dot Com is a mixture of blog posts that can be sometimes serious, frequently playful and probably down-right pointless all in the space of a day. Enjoy your stay, feel free to comment and in the words of the most interesting man in the world: Stay thirsty my friend.