¿ Quieres imprimir esta página ? Volver a la página principal de Recursos iSeries AS400 ¿ Necesitas ayuda ? En pruebas
Recursos iSeries AS400. Compartiendo generamos conocimiento
Novedades en Recursos iSeries AS400
Últimas noticias del iSeries AS400
Convertir expresiones RPGIV formato fijo en formato libre

Categoría : Programación
Autor : Gerardo Santillana
Título : Convertir expresiones RPGIV formato fijo en formato libre

Descripción del truco:
Cuando conviertes un programa RPGIII en RPGIV con la utileria CVTRPGSRC te deja las expresiones IF, DOW, DOU, WHEN, AND, OR en formato fijo.

Esta utilidad convierte estas expresiones en formato libre usadas en el "Extended Factor 2"

ejemplo del codigo al utilizar el CVTRPGSRC

var1 ifeq "valor"
var2 andgt 3000
cont DoUeq 50
exsr r001
enddo
endif

al utilizar esta utileria el codigo quedaria asi
if var1='valor'
and var2 > 3000
Dou count = 50
exsr r001
enddo
endif


Código en formato texto
Fecha 09-01-2004

/*==================================================================*/ /* To compile: */ /* */ /* CRTCMD CMD(XXX/CVTRPGEXP) PGM(XXX/RPGEXPCL) + */ /* SRCFILE(XXX/QCMDSRC) */ /* */ /*==================================================================*/ CMD PROMPT('Convert RPG Expressions') PARM KWD(FROMFILE) TYPE(FROMFILE) MIN(1) + PROMPT('From file') FROMFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('Library') PARM KWD(FROMMBR) TYPE(*NAME) SPCVAL((*FIRST)) + MIN(1) PROMPT('From member') PARM KWD(TOFILE) TYPE(TOFILE) PROMPT('To file') TOFILE: QUAL TYPE(*NAME) DFT(QRPGLESRC) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('Library') PARM KWD(TOMBR) TYPE(*NAME) DFT(*FROMMBR) + SPCVAL((*FROMMBR)) PROMPT('To member') /*==================================================================*/ /*==================================================================*/ /* To compile: */ /* */ /* CRTCLPGM PGM(XXX/RPGEXPCL) SRCFILE(XXX/QCLSRC) */ /* */ /*==================================================================*/ PGM PARM(&FROMFILE &FROMMBR &TOFILE &TOMBR) DCL VAR(&FROMFILE) TYPE(*CHAR) LEN(20) DCL VAR(&FROMMBR) TYPE(*CHAR) LEN(10) DCL VAR(&TOFILE) TYPE(*CHAR) LEN(20) DCL VAR(&TOMBR) TYPE(*CHAR) LEN(10) DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10) DCL VAR(&RTNMBR) TYPE(*CHAR) LEN(10) DCL VAR(&TEXT) TYPE(*CHAR) LEN(50) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Send all errors to error handling routine */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) /* Validate "from" file and member */ RTVMBRD FILE(%SST(&FROMFILE 11 10)/%SST(&FROMFILE 1 + 10)) MBR(&FROMMBR) RTNLIB(&RTNLIB) + RTNMBR(&RTNMBR) FILETYPE(&FILETYPE) + SRCTYPE(&SRCTYPE) TEXT(&TEXT) IF COND(&FILETYPE *NE '*SRC') THEN(SNDPGMMSG + MSGID(CPF0781) MSGF(QCPFMSG) + MSGDTA(%SST(&FROMFILE 1 10) *CAT + %SST(&FROMFILE 11 10)) MSGTYPE(*ESCAPE)) IF COND(&SRCTYPE *NE 'RPGLE' *AND &SRCTYPE *NE + 'SQLRPGLE') THEN(SNDPGMMSG MSGID(EDT1511) + MSGF(QPDA/QEDTMSG) MSGTYPE(*ESCAPE)) CHGVAR VAR(%SST(&FROMFILE 11 10)) VALUE(&RTNLIB) CHGVAR VAR(&FROMMBR) VALUE(&RTNMBR) /* Validate "to" file and member */ RTVOBJD OBJ(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + OBJTYPE(*FILE) RTNLIB(&RTNLIB) CHGVAR VAR(&RTNLIB) VALUE(%SST(&TOFILE 11 10)) IF COND(&TOMBR *EQ '*FROMMBR') THEN(CHGVAR + VAR(&TOMBR) VALUE(&FROMMBR)) CHKOBJ OBJ(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + OBJTYPE(*FILE) MBR(&TOMBR) MONMSG MSGID(CPF9815) EXEC(GOTO CMDLBL(SKIP)) /* Don't allow conversion into same member */ IF COND(&FROMFILE *EQ &TOFILE *AND &FROMMBR *EQ + &TOMBR) THEN(SNDPGMMSG MSGID(CPF2874) + MSGF(QCPFMSG) MSGDTA(&TOFILE *CAT &TOMBR) + MSGTYPE(*ESCAPE)) /* Don't allow conversions if "to" member exists */ SNDPGMMSG MSGID(CPD3211) MSGF(QCPFMSG) + MSGDTA(%SST(&TOFILE 1 10) *CAT + %SST(&TOFILE 11 10) *CAT ' ' + *CAT &TOMBR) MSGTYPE(*ESCAPE) /* Send "Converting... " status message */ SKIP: SNDPGMMSG MSGID(RNS9351) MSGF(QRPGLE/QRPGLEMSG) + MSGDTA(%SST(&FROMFILE 11 10) *CAT + %SST(&FROMFILE 1 10) *CAT &FROMMBR) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Add a new member to the file */ ADDPFM FILE(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + MBR(&TOMBR) TEXT(&TEXT) /* Change the member type to RPGLE */ CHGPFM FILE(%SST(&TOFILE 11 10)/%SST(&TOFILE 1 10)) + MBR(&TOMBR) SRCTYPE(&SRCTYPE) /* Perform file overrides */ OVRDBF FILE(INPUT) TOFILE(%SST(&FROMFILE 11 + 10)/%SST(&FROMFILE 1 10)) MBR(&FROMMBR) + OVRSCOPE(*CALLLVL) OVRDBF FILE(OUTPUT) TOFILE(%SST(&TOFILE 11 + 10)/%SST(&TOFILE 1 10)) MBR(&TOMBR) + OVRSCOPE(*CALLLVL) /* Call program to convert expressions */ CALL PGM(RPGEXPRG) /* Send completion message */ SNDPGMMSG MSGID(CPC7305) MSGF(QCPFMSG) MSGDTA(&TOMBR + *CAT %SST(&TOFILE 11 10) *CAT + %SST(&TOFILE 1 10)) MSGTYPE(*COMP) RETURN /* Error handling routine */ ERROR: RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + MSGFLIB(&MSGFLIB) MONMSG MSGID(CPF0000) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000) ENDPGM: ENDPGM /*==================================================================*/ *=============================================================== * To compile: * * CRTBNDRPG PGM(XXX/RPGEXPRG) SRCFILE(XXX/QRPGLESRC) * *=============================================================== FInput IF F 112 Disk FOutput O F 112 Disk D Relation S 2 D Operator S 3 D OpCode S 4 D Continue S 1 Inz(*Off) D Data S 1 Inz(*Off) D X S 1 0 D DS D Rel1Data 12 Inz('EQNEGTLTGELE') D Rel1 2 Overlay(Rel1Data) Dim(6) D Rel2Data 12 Inz('= <>> < >=<=') D Rel2 2 Overlay(Rel2Data) Dim(6) D OutLin DS D OutSeq 1 6 2 D OutDat 7 12 0 D OutDta 13 112 IInput NS I 1 6 2InpSeq I 7 12 0InpDat I 13 112 InpDta *=============================================================== * Read through input file and write to output file C Read Input 99 C Dow Not *In99 C Eval OutSeq = InpSeq C Eval OutDat = InpDat C Eval OutDta = InpDta C Exsr ChkSource C Except C Read Input 99 C Enddo C Eval *InLR = *On *=============================================================== C ChkSource Begsr * Translate statements to upper case for comparisons C Call 'QDCXLATE' C Parm 100 Length 5 0 C Parm InpDta Source 100 C Parm 'QSYSTRNTBL' Trntbl 10 * Check for compile time data C If %Subst(Source:1:3) = '** ' Or C %Subst(Source:1:9) = '**CTDATA ' C Eval Data = *On C Endif * Don't convert compile time data C If Data = *Off * Only consider non-commented calcs containing a factor 1 entry C If %Subst(Source:6:1) = 'C' And C %Subst(Source:7:1) <> '*' And C %Subst(Source:7:1) <> '+' And C %Subst(Source:12:1) <> ' ' * Perform record selection C Select * Process "If" statements C When %Subst(Source:26:2) = 'IF' C Eval OpCode = %Subst(InpDta:26:2) C Eval Relation = %Subst(Source:28:2) C Exsr FmtOutput * Process "Do While" and "Do Until" statements C When %Subst(Source:26:3) = 'DOW' Or C %Subst(Source:26:3) = 'DOU' C Eval OpCode = %Subst(InpDta:26:3) C Eval Relation = %Subst(Source:29:2) C Exsr FmtOutput * Process "When" statements C When %Subst(Source:26:4) = 'WHEN' C Eval OpCode= %Subst(InpDta:26:4) C Eval Relation = %Subst(Source:30:2) C Exsr FmtOutput * Process "And" statements C When %Subst(Source:26:3) = 'AND' C Eval Continue = *On C Eval Relation = %Subst(Source:29:2) C Eval Operator= %Subst(InpDta:26:3) C Exsr FmtOutput * Process "Or" statements C When %Subst(Source:26:2) = 'OR' C Eval Continue = *On C Eval Relation = %Subst(Source:28:2) C Eval Operator= %Subst(InpDta:26:2) C Exsr FmtOutput C Endsl C Endif C Endif C Endsr *=============================================================== C FmtOutput Begsr * Clear the output data field C Eval OutDta = *Blanks * Load the original statement to the left of factor 1 C Eval %Subst(OutDta:1:11) = %Subst(InpDta:1:11) * Translate the relational operator to its symbolic equivalent C Eval X = 1 C Relation Lookup Rel1(X) 99 C If *In99 = *On C Eval Relation = Rel2(X) C Endif * Concatenatate the rest of the statement together C IF Continue = *On C Eval %Subst(OutDta:36:45) = C %Trim(Operator) + ' ' + C %Trim(%Subst(InpDta:12:14)) + C ' ' + %Trim(Relation) + ' ' + C %Trim(%Subst(InpDta:36:45)) C Eval Continue = *Off C Else C Eval %Subst(OutDta:26:4) = OpCode C Eval %Subst(OutDta:36:45) = C %Trim(%Subst(InpDta:12:14)) + C ' ' + %Trim(Relation) + ' ' + C %Trim(%Subst(InpDta:36:45)) C Eval OpCode = *Blanks C Endif C Endsr *=============================================================== OOutput E O OutLin 112 *===============================================================
¿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$

Comentarios de usuarios

Nombre:
Mail:
Comentario:
 

Subir a la parte superior de la web

Symtrax
Dossiers técnicos iSeries y AS400
- Dossier de seguridad
- Alta disponibilidad.
¿Buscas trabajo ?
Inscríbete en nuestra lista laboral y recibirás las ofertas de trabajo en tu buzón de correo electrónico.
Nuestros links preferidos
- Tendencias tecnologías de la información
Expertos en materías relacionadas con las tecnologías de la información, nos dan su punto de vista sobre las tendencias actuales y futuras
- Los últimos anuncios sobre hardware-software para iSeries AS400 realizados por IBM
- Freeware. Software gratuito para el iSeries AS400
- Utilidades para el iSeries AS400 realizadas por profesionales
- Documentos. Trucos e ideas para resolver tus problemas
- Manuales. Los manuales y links más interesantes del iSeries AS400

  Links patrocinados
  •  
  •  

[ Soy nuevo |   Profesionales |   AS qué |   Empresas |    Foros |   Recomiéndanos |    Productos ]
 
Recursos iSeries AS400 es una web de: Poliedric, s.c.p. CIF:G63005011 Urgell 143 1º1ª 08036 - Barcelona - Tel.+34.902.361.344