|
>>> Dan Swartz <dswartz@courts.state.pa.us> 10/02 1:51 pm >>> >Can anyone point me to a good example of dynamic embedded SQL in an >RPGprogram? I can't guarantee this is good but it works. >I'd like to build the select statement depending on parameter values passed >to the program. You say RPG but if you are not using RPGIV then this is the time to start because it can come in real handy. I have included the following to help you along the way. I cannot send working code without approval so you will have to fill in the blanks. The calling procedure would pass the dynamic parts of a select or an entire select statement. The calling program also should pass a return area to receive the results of the fetch. First call the SQL modules open procedure to build your statement or analyze one passed to set up an SQLDA. Then prepare and open your cursor. If an error is encountered it is returned. Then call the SQL fetch procedure return you information into the area provided. Pertinent code. D*************************************** D* Define SQLDA and associated fields. * D*************************************** DPtrInpFilDA S * INZ(*NULL) DInpFilDA DS BASED(PtrInpFilDA) D SQLDAID 1 8A D SQLDABC 9 12B 0 D SQLN 13 14B 0 D SQLD 15 16B 0 D SQLVAR 80A DIM(120) D SQLTYPE 4B 0 OVERLAY(SQLVAR:1) D SQLLEN 4B 0 OVERLAY(SQLVAR:3) D SQLRES 12A OVERLAY(SQLVAR:5) D SQLDATA * OVERLAY(SQLVAR:17) D SQLIND * OVERLAY(SQLVAR:33) D SQLNAMELEN 4B 0 OVERLAY(SQLVAR:49) D SQLNAME 30A OVERLAY(SQLVAR:51) ... POpnInpFil B EXPORT DOpnInpFil PI 1A OPDESC D SelFld 1024A OPTIONS(*VARSIZE) D CONST D OrdB 128A OPTIONS(*VARSIZE) D CONST DPtrInpFilInp * VALUE DPtrInpFilIndA * VALUE ... field definitions removed. C/EXEC SQL C+ Declare InpFilCsr Cursor for InpFilSel C/END-EXEC C EXSR $GetInpLen C EXSR $BldSelStm C* C IF ErrFlg = *OFF C* C EVAL SQLCOD = *ZEROS C DOU SQLCOD <> -519 C* C IF SQLCOD = -519 C/EXEC SQL C+ Close InpFilCsr C/END-EXEC C END C/EXEC SQL C+ Prepare InpFilSel Into :InpFilDA From :InpFilStm C/END-EXEC C ENDDO C EXSR $SetInpA C* C IF SQLCOD = *ZEROS OR C SQLCOD > *ZEROS C/EXEC SQL C+ Open InpFilCsr C/END-EXEC C END C* C IF SQLCOD < *ZEROS C EVAL ErrFlg = *ON C DEALLOC(N) PtrInpFilDA C END C END C* C RETURN ErrFlg ... SR to get length of field string and order by. C CALLP CEEDOD(1: C DscTyp: C DtaTyp: C DscInf1: C DscInf2: C InpLen: C *OMIT) C EVAL LenSelFld = InpLen C CALLP CEEDOD(2: C DscTyp: C DtaTyp: C DscInf1: C DscInf2: C InpLen: C *OMIT) C EVAL LenOrdB = InpLen ... Subroutine to setup SQLDA to point to return area. C 1 DO FldCnt IdxSqlVar C IF Odd(SQLTYPE(IdxSqlVar)) C = *OFF C EVAL SQLTYPE(IdxSqlVar) C = SQLTYPE(IdxSqlVar) + 1 C END C* C EVAL SQLDATA(IdxSqlVar) C = PtrInpFilInp + OffInpFilInp C EVAL SQLIND(IdxSqlVar) C = PtrInpFilIndA + OffInpFilIndA C EVAL OffInpFilInp C = OffInpFilInp + C SQLLEN(IdxSqlVar) C EVAL OffInpFilIndA C = OffInpFilIndA + 2 C ENDDO ... Subroutine to allocate storage for SQLDA C FldCnt DOUEQ 120 C StrPos ORGT LenSelFld C EVAL FldCnt = FldCnt + 1 C EVAL StrPos = StrPos + 1 C ',' SCAN SelFld:StrPos StrPos C* C StrPos IFEQ *ZEROS C LEAVE C END C ENDDO C* C EVAL SizInpFilDA = FldCnt*%SIZE(SQLVAR)+16 C* C IF PtrInpFilDA C <> *NULL C DEALLOC(N) PtrInpFilDA C END C* C ALLOC SizInpFilDA PtrInpFilDA C EVAL SQLN = FldCnt C EVAL SQLD = FldCnt ... Complete select statement. C IF LenOrdB <> *ZEROS And C OrdB <> *BLANKS C EVAL InpFilStm = %TRIMR(InpFilStm) + ' + C Order by ' + C %SUBST(OrdB:1:LenOrdB) C END ... Fetch procedure partial code. C/EXEC SQL C+ Fetch From InpFilCsr Using Descriptor :InpFilDA C/END-EXEC C SELECT C* C WHEN SqlCod < *ZEROS C EVAL ErrFlg = *ON C EVAL EndFlg = *ON C* C WHEN SqlCod = 100 C EVAL EndFlg = *ON C ENDSL I could provide more detail but I will have to get approval. If you think you need more I will ask. David Morris +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to "MIDRANGE-L@midrange.com". | To unsubscribe from this list send email to MAJORDOMO@midrange.com | and specify 'unsubscribe MIDRANGE-L' in the body of your message. | Questions should be directed to the list owner/operator: david@midrange.com +---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
