bvstone

Query To eRPG (QRY2ERPG) - A Blast From the Past

Posted:

Query To eRPG (QRY2ERPG) - A Blast From the Past

After seeing a few articles about IBM's Web Query for i it got me thinking to over 15 years ago when I thought I had stumbled on the end-all beat-all app for the IBM i (well, AS/400 at that time).  I remember my wife and I going out for supper (to Applebees.. yes, it's that clear in my mind still) and I explained it to her.  She looked at me and nodded, showing at least partial interest and maybe even a little understanding.  

I called it Query to eRPG (QRY2RPG).  What it did was allow you to take a query definition (created with Query/400), and then instantly turn that into an eRPG (CGI) program.  

What use was this?  Back then (and even still today) creating web applications with RPG still really hasn't caught on, even though I find it very useful and powerful.  Yes, I probably am a little biased, but during that time there really wasn't anything else.  Then things like Websphere, CGIDEV2, and even my own e-RPG SDK were released.

But back to this application known as QRY2ERPG.  I wanted to see if it still worked, even on my V7R3 machine.  So, I searched my archives for the last version, FTP'd the save file to my IBM i, restored the library and ran the QRY2ERPG command:

QRY2ERPG FROMQRY(MYLIB/ITEMPF) TOFILE(CGILIB/QRPGLESRC) TOMBR(Q_ITEMPF)          

When this was done (and it did complete successfully the first time!) I looked and saw that sure enough, a program object named Q_ITEMPF was placed in CGILIB.  But no source... then I remembered, without a license key it wouldn't save the source.  So, I applied a key, ran the command again, and my source was there!  How's this for a flashback:

      ****************************************************************
      * To Compile:                                                  *
      *                                                              *
      * 1. CRTSQLRPGI OBJ(lib/pgm) SRCFILE(lib/file) +               *
      *     OBJTYPE(*MODULE) TGTRLS(V3R7M0)                          *
      * 2. CRTPGM PGM(cgilib/pgm) MODULE(lib/pgm) +                  *
      *     BNDSRVPGM(QHTTPSVR/QZHBCGI) TGTRLS(V3R7M0)               *
      *                                                              *
      * Module and program must be created with a minimum target     *
      *  release of V3R7M0.                                          *
      *                                                              *
      * Program must be bound with service program QZHBCGI in        *
      *  library QHTTPSVR or your CGI library where a copy of this   *
      *  service program resides.                                    *
      *                                                              *
      * At least *USE authority must be granted to User ID           *
      *  QTMHHTP1 (or the user profile specified on the USER         *
      *  directive of your HTTP Configuration) in order to function. *
      *                                                              *
      * Your HTTP configuration must be set up to allow execution    *
      *  of CGI programs using the EXEC directive.  This directive   *
      *  must specify *.PGM for the extention or you will have to    *
      *  modify the $Footer subrouting to include .PGM to the end    *
      *  of the program name in the hyperlink.                       *
      * EXEC /cgi-bin/* /QSYS.LIB/AS400CGI.LIB/*.PGM                 *
      *                                                              *
      * For more information on e-RPG programming, see the book:     *
      *  "e-RPG: Building Web Applications with RPG" by Bradley      *
      *  V. Stone.  This book is available from Midrange Computing   *
      *  at:                                                         *
      *  http://www.midrangecomputing.com                            *
      *                                                              *
      * Source Created by Query to e-RPG (QRY2ERPG) from BVS/Tools   *
      * http://www.bvstools.com                                      *
      *                                                              *
      ****************************************************************
      ****************************************************************
     D                SDS
     D  W$PGM                  1     10
      *
     D INFDS           DS
     D  F$RRN                397    400B 0
      *
     D WPError         DS
     D  EBytesP                1      4B 0 INZ(40)
     D  EBytesA                5      8B 0
     D  EMsgID                 9     15
     D  EReserverd            16     16
     D  EData                 17     56
      *
      * This is header information that is written to the HTML file first.  The
      * date is used so that caching does not take place and the data is always
      * refreshed.  You will need at least the HTTPHeader and two new line
      * characters.
      *
     D HTTPHeader      C                   CONST('Content-type: text/html')
     D Pragma          C                   CONST('Pragma: no-cache')
     D Expires1        C                   CONST('Expires: Tuesday, October ')
     D Expires2        C                   CONST('26, 1999 10:10:10 GMT')
     D NewLine         C                   CONST(X'15')
      *
     D ITEMPFDS      E DS                  EXTNAME(ITEMPF) PREFIX(T01)
      *
     D CmdStr          S             64
     D ParseFmt        S              8    INZ('CGII0200')
     D TgtBuf          S           1024
     D TgtBufLen       S              9B 0 INZ(%size(TgtBuf))
     D RespLen         S              9B 0
      *
     D WrtDta          S           1024
     D WrtDtaLen       S              9B 0
      *
     D LastRRN         S              9  0
     D LastRRNx        S              9
     D Count           S              4  0
     D i               S              4  0
      ****************************************************************
     C                   EXSR      $Header
     C                   EXSR      $Main
     C                   EXSR      $Footer
      *
     C                   eval      *INLR = *On
      ****************************************************************
      * Write Header data to Browser
      ****************************************************************
     C     $Header       BEGSR
      *
     C                   eval      WrtDta = '<html><head>' +
     C                             '<title>' +
     C                             '</title>' +
     C                             '</head><body>' +
     C                             NewLine
     C                   EXSR      $WrStout
      *
      * This portion writes a stylesheet to format the data in a table.  Character
      *  data is left justified in table cells and numeric data is right justified
      *  in table cells.  For more infomation on stylesheets go to:
      *  http://www.htmlhelp.com/reference/css/
      *  or
      *  http://msdn.microsoft.com/workshop/author/css/css.asp
      *
     C                   eval      WrtDta = '<style type="text/css">' +
     C                                      NewLine +
     C                                      'td.char {font-size: 8pt;' +
     C                                      NewLine +
     C                                      'font-family: ' +
     C                                      '"geneva","arial","verdana";' +
     C                                      'font-weight: normal;' +
     C                                      'text-align: left}' +
     C                                      'td.num {font-size: 8pt;' +
     C                                      NewLine +
     C                                      'font-family: ' +
     C                                      '"geneva","arial","verdana";' +
     C                                      'font-weight: normal;' +
     C                                      'text-align: right}' +
     C                                      NewLine +
     C                                      '</style>' +
     C                                      NewLine
     C                   EXSR      $WrStout
      *
     C                   ENDSR
      ****************************************************************
      * Write Main Data to Browser
      ****************************************************************
     C     $Main         BEGSR
      *
     C                   eval      WrtDta = '<table ' +
     C                             'border="1" ' +
     C                             'cellspacing="0" ' +
     C                             'cellpadding="3" ' +
     C                             '>' + NewLine
     C                   EXSR      $WrStout
      *
     C                   eval      WrtDta = '<tr>' +
     C                             '<td class="char">' +
     C                             'ITITEM' +
     C                             '</td>' +
     C                             '<td class="char">' +
     C                             'ITIDESC' +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             'ITPRICE' +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             'ITQTY' +
     C                             '</td>' +
     C                             '</tr>' +
     C                             Newline
     C                   EXSR      $WrStout
      *
     C/EXEC SQL
     C+ DECLARE C1 DYNAMIC SCROLL CURSOR FOR
     C+ SELECT
     C+ T01.ITITEM,
     C+ T01.ITIDESC,
     C+ T01.ITPRICE,
     C+ T01.ITQTY
     C+  FROM
     C+ MYLIB/ITEMPF T01
     C/END-EXEC
      *
     C/EXEC SQL
     C+ OPEN C1
     C/END-EXEC
      *
     C                   eval      Count = 0
      *
     C                   if        (LastRRN <= 0)
     C                   eval      LastRRN = 1
     C                   endif
      *
     C/EXEC SQL
     C+ FETCH RELATIVE :LastRRN FROM C1 INTO
     C+ :T01ITITEM,
     C+ :T01ITIDESC,
     C+ :T01ITPRICE,
     C+ :T01ITQTY
     C/END-EXEC
      *
     C                   dow       (SQLCOD = 0) and (Count < 30)
     C                   eval      WrtDta = '<tr>' +
     C                             '<td class="char">' +
     C                             %trim(T01ITITEM) +
     C                             '</td>' +
     C                             '<td class="char">' +
     C                             %trim(T01ITIDESC) +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             %trim(%editc(T01ITPRICE:'L')) +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             %trim(%editc(T01ITQTY:'L')) +
     C                             '</td>' +
     C                             '</tr>' +
     C                             Newline
     C                   EXSR      $WrStout
     C                   eval      Count = (Count + 1)
     C                   eval      LastRRN = (LastRRN + 1)
      *
     C/EXEC SQL
     C+ FETCH C1 INTO
     C+ :T01ITITEM,
     C+ :T01ITIDESC,
     C+ :T01ITPRICE,
     C+ :T01ITQTY
     C/END-EXEC
      *
     C                   enddo
      *
     C                   eval      WrtDta = '</table>' + NewLine
     C                   EXSR      $WrStout
      *
     C                   ENDSR
      ****************************************************************
      * Write Footer Data to Browser
      ****************************************************************
     C     $Footer       BEGSR
      *
     C                   if        (SQLCOD <> 0)
     C                   eval      WrtDta = '<i><b>End of Listing</b></i>'
     C                   else
     C                   MOVE      LastRRN       LastRRNx
     C                   eval      WrtDta = '<a href="' +
     C                             %trim(W$PGM) +
     C                             '?LastRRN=' +
     C                             %trim(LastRRNx) +
     C                             '">Next Page</a>'
     C                   endif
      *
     C                   EXSR      $WrStout
      *
     C                   eval      WrtDta = '</body></html>' +
     C                             NewLine
     C                   EXSR      $WrStout
      *
     C                   ENDSR
      ****************************************************************
      * Call the Write Standard Output API
      ****************************************************************
     C     $WrStout      BEGSR
      *
     C                   eval      WrtDtaLen = %len(%trim(WrtDta))
      *
     C                   CALLB     'QtmhWrStout'
     C                   PARM                    WrtDta
     C                   PARM                    WrtDtaLen
     C                   PARM                    WPError
      *
     C                   ENDSR
      ****************************************************************
      * Call the CGI Parse API
      ****************************************************************
     C     $CGIParse     BEGSR
      *
     C                   CALLB     'QzhbCgiParse'
     C                   PARM                    CmdStr
     C                   PARM      'CGII0200'    ParseFmt
     C                   PARM                    TgtBuf
     C                   PARM                    TgtBufLen
     C                   PARM                    RespLen
     C                   PARM                    WPError
      *
     C                   ENDSR
      ****************************************************************
      * Initialization Subroutine
      ****************************************************************
     C     *INZSR        BEGSR
      *
      * Do Not remove this portion of code.  CGI programs are required to
      *  write header records followed by two new line characters in order
      *  to function properly.  You may remove the Pragma, Expires1 and
      *  Expires2, but then your browser must handle caching.
      *
     C                   eval      WrtDta = %trim(HTTPHeader) +
     C                                      NewLine + Pragma +
     C                                      NewLine + Expires1 +
     C                                      NewLine + Expires2 +
     C                                      NewLine + NewLine
     C                   EXSR      $WrStout
      *
      * Retrieve Query String Environment Variables.
      *
     C                   eval      CmdStr = '-value LastRRN' + X'00'
     C                   EXSR      $CGIParse
      *
      * If the Response Length is zero, then no Query String Environment Variables
      *  existed.  Set the value of LastRRNx to blank.
      *
     C                   if        (RespLen > 0)
     C     X'25'         SCAN      TgtBuf:1      i                        99
     C                   eval      LastRRNx = %trim(%subst(TgtBuf:1:i-1))
     C                   else
     C                   eval      LastRRNx = ' '
     C                   endif
      *
     C                   MOVE      LastRRNx      LastRRN
      *
     C                   ENDSR

When I went to run the program, I noticed that no data was showing up.  The job log quickly showed that my web program didn't have authority to the MYLIB library where the data was stored.  Once granted, I was presented with the following:

http://www.bvstools.com/cgi-bin/q_itempf (which doesn't seem to be working right now... bummer)

A simple but effective eRPG application with built in pagination as well!  The only issue was that the 2nd time I ran it, it also didn't work.  A quick look showed me that there was no close to the SQL cursor.  So, I added that, and it worked great again.

The theory behind this tool was rather simple... retrieve the query definition (which is sql) and wrap an RPG program around it.  Users back then were free to create queries they needed, and Query/400 was the tool to use.  This was before SQL become popular in the midrange world as well.  So, thinking back, I can see why I thought this was going to be quite the utility!  Anyone could easily create eRPG programs in just seconds.

I don't recall why I ended up taking it off my site.  Probably because back then it was a little too early to be forcing web applications on people.   

I haven't yet tried it on any "complex" query definitions yet, but seeing as how this still worked almost 20 years later on V3Rx and now on V7R3, I was pretty impressed and just wanted to share this since I got a good chuckle and a big smile out of something that old...  sort of like when my 64 VW Beetle fires right up the first time.


Last edited 07/17/2018 at 10:07:52



Latest Posts:

MAILTOOL Updated to Allow Use of IBM Global Security Kit (GSKIT) for SSL/TLS Communications MAILTOOL Updated to Allow Use of IBM Global Security Kit (GSKIT) for SSL/TLS Communications
Posted by 14 hours ago
BVSTools >> BVSTools Announcements >> eMail Tool (MAILTOOL) Specific Announcements
GETURI v10.00 Released Supporting IBM Global Security Kit (GSKIT) and Server Name Indication (SNI) GETURI v10.00 Released Supporting IBM Global Security Kit (GSKIT) and Server Name Indication (SNI)
Posted by June 11, 2019
BVSTools >> BVSTools Announcements >> Get URI (GETURI) Specific Announcements
BVSTools Now Offers Vertex Cloud Interface BVSTools Now Offers Vertex Cloud Interface
Posted by April 15, 2019
BVSTools >> BVSTools Announcements
Token Has an Invalid Signature Error for Office 365 Email Token Has an Invalid Signature Error for Office 365 Email
Posted by March 22, 2019
BVSTools >> BVSTools Software Discussion >> GreenTools for Microsoft Apps (G4MS) Specific Discussion
Resending Emails that have Errored Out with Updated Router or Authentication Information Resending Emails that have Errored Out with Updated Router or Authentication Information
Posted by March 1, 2019
BVSTools >> BVSTools Software Discussion >> Email Tools (MAILTOOL) Specific Discussion
BVSTools Offers Toolset to Work With HubSpot OAuth 2.0 APIs On Your IBM i BVSTools Offers Toolset to Work With HubSpot OAuth 2.0 APIs On Your IBM i
Posted by January 27, 2019
BVSTools >> BVSTools Announcements
G4MSDRV Currently Not Supported G4MSDRV Currently Not Supported
Posted by January 17, 2019
BVSTools >> BVSTools Announcements >> GreenTools for Microsoft Apps (G4MS) Specific Announcements
Removing Trailing Carriage Returns and/or Line Feeds from a String with RPG Removing Trailing Carriage Returns and/or Line Feeds from a String with RPG
Posted by December 26, 2018
Programming >> RPG Programming
Create QRCODE in DDS Create QRCODE in DDS
Posted by September 21, 2018
Programming >> RPG Programming
Base64 Encoding a File with RPG Base64 Encoding a File with RPG
Posted by September 6, 2018
Programming >> RPG Programming
Building JSON with RPG and YAJL and Writing to Standard Output Building JSON with RPG and YAJL and Writing to Standard Output
Posted by August 31, 2018
Programming >> Proof of Concept (POC)
How to Delete Files or Empty Trash From Your Google Drive with your IBM i and RPG/ILE How to Delete Files or Empty Trash From Your Google Drive with your IBM i and RPG/ILE
Posted by July 24, 2018
BVSTools >> BVSTools Software Discussion >> GreenTools for G Suite (Google Apps) (G4G) Specific Discussion
GreenTools for G Suite (G4G) Updated to Include Delete and Empty Trash Function GreenTools for G Suite (G4G) Updated to Include Delete and Empty Trash Function
Posted by July 24, 2018
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
What to Do If Your License Keys Don't Work What to Do If Your License Keys Don't Work
Posted by July 18, 2018
BVSTools >> BVSTools Software Discussion
MAILTOOL Updated to Allow Failed Message on Invalid Recipient MAILTOOL Updated to Allow Failed Message on Invalid Recipient
Posted by May 20, 2018
BVSTools >> BVSTools Announcements >> eMail Tool (MAILTOOL) Specific Announcements

Reply




Copyright 1983-2019 BVSTools
GreenBoard(v3) Powered by the eRPG SDK, MAILTOOL Plus!, GreenTools for Google Apps, jQuery, jQuery UI, BlockUI, CKEditor and running on the IBM i (AKA AS/400, iSeries, System i).