| Categoría : Programación
Autor : Carlos Robles Espinoza
Título : Armado de un SQL dinamico en SQLRPGLE
Descripción del truco:
Este truco consiste en el armado de sentencia SQL dinamicamente
segun parametros recibidos que pude ser tambien una
pantalla, para el ejemplo se tomo el ingreso por *entry.
Si se ingresa un dato se arma la sentencia con ese dato
recibido y asi susecivamente con los siguientes, aca
es la condicion por EQ y AND.
El secreto esta en el SQL sentencias Prepare y Declare.
Esto ya esta probado y aceptado para una aplicacion
on-line en desarrollo con mas de 17 opciones de seleccion
dinamicas ademas se le agrego order by. Funciona, con
esto no se crean 17 LF.
Esta realizado en SQLRPGLE tiene algo de free, el real
esta en desarrollo en free y sub-file. Espero que les ayude este ejemplo. H Debug Option(*nodebugio)
*
*
** Sistema : Consulta masiva on-line *
** Modulo : *
** Analisis : Carlos Robles Espnoza *
** Programacion: Carlos Robles Espinoza SIDESYS *
** Fecha.......: Octubre 2004 - Argentina *
* *
** Descripción : Arma un SQL dinamicamente segun parametros *
** ingresados. *
** Es un fuente Beta que va a servir como base *
** para una aplicacion on-line de consulta masiva *
** para usuarios finales. *
* *
* *
FTCIPICCOUTIF A E K DISK rename(CIPICCTI:OUPICCTI)
F prefix(ou:2) usropn
* ===================================================================
* Auxiliares para SQL
* Variables tipo const
D VarSelect c const('select tifecp, tifdpf, tificc-
D ,tifrec, tihora, tinnrr, tirrec -
D from tcipicc where ')
D VarEq c const(' = ')
D VarAnd c const(' and ')
D VarFdpf c const(' tifdpf')
D VarFicc c const(' tificc')
D VarFecp c const(' tifecp')
*
D VarAll s 1000a inz(*blanks)
*
* Sentencia para SQL
D Str_sql s 1000a inz(*blanks)
* ===============================================================
D s$_fdpf s like(oufdpf) inz(*blanks)
D s$_ficc s like(ouficc) inz(*zeros)
D s$_fecp s like(oufecp) inz(*zeros)
D ip_flag s n DIM(3)
* Definicion de un Prototipo para QCMDEXC
D CmdData s 80A inz('Clrpfm *libl/TCIPICCOUT')
D RunSysCmd PR extpgm('QCMDEXC')
D Cmd 200A options(*varsize) const
D CmdLen 15P 5 const
D SDS
D Prog *proc
D Parms *parms
D Pgm_lib 81 90
D Job_name 244 253
D User 254 263
D Job_num 264 269s 0
C *entry plist
C parm ip_fdpf 10
C parm ip_ficc 8
C parm ip_fecp 8
C exsr rinicio
* Asigna valores por Num. parametros ingresados
C if ip_fdpf <> *blanks
C move ip_fdpf s$_fdpf
C eval ip_flag(1) = *on
C endif
C if ip_ficc <> *blanks
C move ip_ficc s$_ficc
C eval ip_flag(2) = *on
C endif
C if ip_fecp <> *blanks
C move ip_fecp s$_fecp
C eval ip_flag(3) = *on
C endif
/free
VarAll = VarSelect;
if ip_flag(1);
VarAll = %trimr(VarAll) + VarFdpf + VarEq
+ '''' + s$_fdpf + '''';
endif;
if ip_flag(2);
if VarAll <> VarSelect;
VarAll = %trimr(VarAll) + VarAnd;
endif;
VarAll = %trimr(VarAll) + VarFicc + VarEq
+ %char(s$_ficc);
endif;
if ip_flag(3);
if VarAll <> VarSelect;
VarAll = %trimr(VarAll) + VarAnd;
endif;
VarAll = %trimr(VarAll) + VarFecp + VarEq
+ %char(s$_fecp);
endif;
Str_sql = VarAll;
/end-free
* Prepara y carga variables SQL
C/EXEC SQL
C+ Prepare P1 From : str_sql
C/End-Exec
* Declara Cursor
C/EXEC SQL
C+ DECLARE C1 CURSOR FOR P1
C/END-EXEC
*
C/EXEC SQL
C+ OPEN C1
C/END-EXEC
C exsr ex_fetch
* FIN Pgm
C eval *inlr = *on
* ----------- -------
C ex_fetch Begsr
* ----------- -------
C/EXEC SQL FETCH C1 INTO
C+ :oufecp,:oufdpf,:ouficc,:oufrec,:ouhora,:ounnrr,:ourrec
C/END-EXEC
* Graba Mientras no es fin de DB
C DOW SQLCOD = 0
C write OUPICCTI
C/EXEC SQL FETCH C1 INTO
C+ :oufecp,:oufdpf,:ouficc,:oufrec,:ouhora,:ounnrr,:ourrec
C/END-EXEC
C enddo
C/EXEC SQL CLOSE C1
C/END-EXEC
C Endsr
* -------
* ----------- -------
C rinicio Begsr
* ----------- -------
* Borra archivo fisico (CLRPFM)
C CALLP(E) RunSysCmd(CmdData: %size(CmdData))
C Open TCIPICCOUT
C Endsr
Ver
código fuente
Fecha 25-10-2004
Tienes algún truco que quieras compartir con todos
los profesionales de Recursos iSeries AS400?.Envianoslo
y si resulta seleccionado te enviaremos un vale de Amazon
por valor de 50$
|
