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:

GreenTools for G Suite (G4G) Now Includes Send Mail Functionality (G4GSMAIL Addon) GreenTools for G Suite (G4G) Now Includes Send Mail Functionality (G4GSMAIL Addon)
Posted by August 27, 2019
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
GreenTools For G Suite (G4G) v12.00 Released With Base OAuth 2.0 Functionality GreenTools For G Suite (G4G) v12.00 Released With Base OAuth 2.0 Functionality
Posted by July 28, 2019
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
BVSTools Small Price Increase in 2020 BVSTools Small Price Increase in 2020
Posted by July 26, 2019
BVSTools >> BVSTools Announcements
GreenTools for Vertex Cloud (VTXCLOUD) Now Available GreenTools for Vertex Cloud (VTXCLOUD) Now Available
Posted by July 22, 2019
BVSTools >> BVSTools Announcements >> GreenTools for Vertex Cloud (VTXCLOUD) Specific Announcements
GreenTools for Google Apps (G4G) - Drive Addon Successfully Verified by Google GreenTools for Google Apps (G4G) - Drive Addon Successfully Verified by Google
Posted by July 22, 2019
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
Why I Cancelled my DynDNS Service and How I Replaced It with an IBM i Application Why I Cancelled my DynDNS Service and How I Replaced It with an IBM i Application
Posted by July 17, 2019
IBM Power Systems >> (QGPL) IBM i
Green Tools for G Suite (G4G) Product Updates (Licensing, Functionality, Base Product) Green Tools for G Suite (G4G) Product Updates (Licensing, Functionality, Base Product)
Posted by July 13, 2019
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
Reading JSON Data from Standard Input With YAJL and RPG Reading JSON Data from Standard Input With YAJL and RPG
Posted by July 12, 2019
Programming >> Proof of Concept (POC)
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 June 19, 2019
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

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).