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 *
* https://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:
https://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.