Se que es un poco tarde pero te envio un programa que recupera los fuentes RPGLE a
partir de su objeto, asi para la proxima ya no vas a tener que estar con copy/paste
solo lo ejecutas de esta manera y listo
CALL biblioteca/RTVRPGLES PARM('OBJETO BIBLIOTECA' 'QRPGLESRC BIBLIOTECA'
'OBJETO')
Saludos
Gerardo Santillana
IT Department
Delphi Mechatronic Systems
US Ph: (956) 554 5832
MX Ph: (868) 812 81 63/64/65 Ext 5832
Pager: (956) 768 1048
e-mail [EMAIL PROTECTED]
-----Original Message-----
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] Behalf Of
[EMAIL PROTECTED]
Sent: Friday, May 14, 2004 9:43 AM Gerardo
To: [EMAIL PROTECTED]
Subject: RE: Recuperar fuente
Buena idea...
ha sido una ardua tarea de copy/paste pero gracias a compilar con la opci�n
*LIST he conseguido regenerar el fuente.
_____________________________________________
Jose Luis Aguilera
Analista
Ediciones Rueda JM, S.A.
Los Mesejo, 15
28007 Madrid
Tfno:914 343 883 / 914 343 860 Ext: 166
Fax: 915 518 161
Dpto.Inform�tica
Prod.Climax(Jos�
S�nchez) Para
<[EMAIL PROTECTED] <[EMAIL PROTECTED]>
uctosclimax.com> cc
Enviado por:
forum.help400-req Asunto
[EMAIL PROTECTED] RE: Recuperar fuente
14/05/04 15:08
Por favor,
responda a
[EMAIL PROTECTED]
bios.es
Igual es una chapucilla, pero si puedes hacer un debug llegarias a ver el
fuente y poderlo comparar con el que dices que no coincide.
Saludos
-----Mensaje original-----
De: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED]
Enviado el: viernes, 14 de mayo de 2004 14:57
Para: [EMAIL PROTECTED]
Asunto: Recuperar fuente
Buen Viernes,
Una pregunta que creo no tiene soluci�n pero que de todas formas formulo al
foro, existe la posibilidad de recuperar el fuente de un programa RPG-ILE a
partir de su PGM,
El soporte que tengo en cinta del fuente no se corresponde con el PGM
compilado y no hay manera de localizarlo.
Un Saludo.
_____________________________________________
Jose Luis Aguilera
Analista
Ediciones Rueda JM, S.A.
_____________________________________________________
Forum.HELP400 es un servicio m�s de NEWS/400.
� Publicaciones Help400, S.L. - Todos los derechos reservados
http://www.help400.es
_____________________________________________________
Para darte de baja, env�a el mensaje resultante de pulsar
mailto:[EMAIL PROTECTED]
_____________________________________________________
Forum.HELP400 es un servicio m�s de NEWS/400.
� Publicaciones Help400, S.L. - Todos los derechos reservados
http://www.help400.es
_____________________________________________________
Para darte de baja, env�a el mensaje resultante de pulsar
mailto:[EMAIL PROTECTED]
________________________________________________________________________________________
Este mensaje ha sido analizado y protegido por la tecnologia antivirus
www.trendmicro.es
_____________________________________________________
Forum.HELP400 es un servicio m�s de NEWS/400.
� Publicaciones Help400, S.L. - Todos los derechos reservados
http://www.help400.es
_____________________________________________________
Para darte de baja, env�a el mensaje resultante de pulsar
mailto:[EMAIL PROTECTED]
****************************************************************************************
Note: The information contained in this message may be privileged and confidential and
thus protected from disclosure. If the reader of this message is not the intended
recipient, or an employee or agent responsible for delivering this message to the
intended recipient, you are hereby notified that any dissemination, distribution or
copying of this communication is strictly prohibited. If you have received this
communication in error, please notify us immediately by replying to the message and
deleting it from your computer. Thank you.
**************************************************************************************** H Option(*srcstmt)
*******************************************************************
*--RTVRPG Converts RPGLE program dump to source code
*******************************************************************
frtvwork if e disk
fqrpglesrc uf a e disk rename(qrpglesrc:qrpglesrcf) usropn
d begsource c '*MODULE ENTRY'
d endsource c 'MAIN PROCEDURE -
d EXIT'
d up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
d lo c 'abcdefghijklmnopqrstuvwxyz'
d i s 3 0
d j s 3 0
d k s 3 0
d l s 3 0
d numout s 8 0
d skip# s 8 0
d ctarray# s 3 0 inz(0)
d temp80 s 80
d cursor s 3 0
d ipos s 2 0
d error s 1 inz('N')
d pmerror s 1
d hex s 1a dim(16) ctdata perrcd(16)
d goodstuff ds
d goodchr 1 dim(32)
d srcdta ds
d srcchr 1 dim(100)
d lindta ds
d linchr 1 dim(100)
d srcdatea ds
d datechr 1 dim(6)
d hexin ds
d hexchr 1 dim(6)
c *entry plist
c parm error pmerror
c open qrpglesrc
*--Locate beginning of source text
c read rtvwork
c eval ipos = %scan(begsource:goodstuff)
c dou ipos <> 0
c read rtvwork
c eval ipos = %scan(begsource:goodstuff)
*--If no start string, object was not rpgle compiled with *LSTDBG
c if %eof(rtvwork) = *on
c eval error = 'Y'
c seton lr
c return
c endif
c enddo
*--Determine offset to beginning of statement line
c eval cursor = 32 - ipos
c dou cursor > 136
c read rtvwork
c if hexstuff = *blank
c if %scan('LINES':hexstuff) <> 0
c exsr $SKIP
c do skip#
c eval cursor = cursor + 32
c enddo
c endif
c else
c eval cursor = cursor + 32
c endif
c enddo
c eval j = 6
c eval i = 32 - (cursor - 136) + 1
*--Load rpg code (field lindta fields 1-100)
c dow %eof(rtvwork) = *off
c dou i > 32
c if j < 101
c eval linchr(j) = goodchr(i)
c endif
*--Load line marking (field srcdta fields 1-5)
* Don't load if line copied from external def (pos 5 = '=')
c if j > 105 and j < 111
c and linchr(5) <> '='
c eval k = j - 105
c eval srcchr(k) = goodchr(i)
c endif
*--Load line dates (field srcdat)
c if j > 111 and j < 118
c eval k = j - 111
c eval datechr(k) = goodchr(i)
c endif
c eval i = i +1
c eval j = j +1
*--Test for end of input for this source line
c if j > 136
c eval j = 1
*--Test for end of input source file data
c if %scan(endsource:lindta) <> 0 and
c linchr(5) = '*'
c close qrpglesrc
c if ctarray# > *zero
c exsr $FIXARRAY
c endif
c seton lr
c return
c endif
*--Test for valid line date
c testn srcdatea 30
c if *in30 = *off
c eval srcdat = *zeros
c else
c move srcdatea srcdat
c endif
c*--Shift compile time arrays
c if linchr(5) <> '='
*--Count the number of compile time arrays
c if linchr(6) = 'd' or linchr(6) = 'D'
c lo:up xlate lindta temp80
c if %scan('CTDATA':temp80) <> 0 and
c linchr(7) <> '*'
c eval ctarray# = ctarray# + 1
c endif
c endif
c eval %subst(srcdta:6:95) = %subst(lindta:6:95)
c exsr $RMVJUNK
c write qrpglesrcf
c else
c clear qrpglesrcf
c endif
c endif
c enddo
*--Test for end of input line
c if i > 32
c eval i = 1
c endif
*--Bypass records with no data
c dou hexadr <> *blank
c if %scan('LINES':hexstuff) <> 0
c exsr $SKIP
c endif
*--If 'SAME AS ABOVE' appears in input, act as if blank lines were
read
c if skip# > *zero
c eval skip# = skip# - 1
c eval hexstuff = *blank
c eval hexadr = 'FAKEIT'
c iter
c endif
c read rtvwork
c enddo
c enddo
*******************************************************************
*--$SKIP skip input based upon repeating lines
*******************************************************************
csr $SKIP begsr
c eval hexin = %subst(hexstuff:24:6)
c exsr $CVTHEX
c eval skip# = numout
c eval hexin = %subst(hexstuff:8:6)
c exsr $CVTHEX
c eval skip# = (skip# - numout + 1)/32
csr endsr
*******************************************************************
*--$RMVJUNK remove compiler generated junk
*******************************************************************
csr $RMVJUNK begsr
*--Get rid of '--' in c spec indicator fields
c if srcchr(6) = 'C' or srcchr(6) = 'c'
c dou k = 0
c eval k = %scan('--':srcdta:71)
c if k <> *zero
c eval srcdta = %replace(' ':srcdta:k)
c endif
c enddo
c endif
csr endsr
*******************************************************************
*--$FIXARRAY shift compile time arrays
*******************************************************************
csr $FIXARRAY begsr
c open qrpglesrc
c *hival setgt qrpglesrc
*--Position at beginning of last array
c readp qrpglesrc
c dou %eof(qrpglesrc) = *on or
c ctarray# = *zero
c if %subst(srcdta:6:2) = '**'
c eval ctarray# = ctarray# - 1
c endif
c readp qrpglesrc
c enddo
c read qrpglesrc
c exsr $SHIFT6L
csr endsr
*******************************************************************
*--$SHIFT6L shift line 6 pos to left (for compile time arrays)
*******************************************************************
csr $SHIFT6L begsr
c dou %eof(qrpglesrc) = *on
c eval %subst(srcdta:1:95) = %subst(srcdta:6:95) +
c ' '
c update qrpglesrcf
c read qrpglesrc
c enddo
csr endsr
*******************************************************************
*--$CVTHEX convert hex to numeric
*******************************************************************
csr $CVTHEX begsr
c eval numout = *zero
c 1 do 6 k
c eval l = 1
c hexchr(k) lookup hex(l) 30
c select
c when k = 1
c eval numout = numout + (l - 1) * 16**5
c when k = 2
c eval numout = numout + (l - 1) * 16**4
c when k = 3
c eval numout = numout + (l - 1) * 16**3
c when k = 4
c eval numout = numout + (l - 1) * 16**2
c when k = 5
c eval numout = numout + (l - 1) * 16
c when k = 6
c eval numout = numout + (l - 1)
c endsl
c enddo
c
csr endsr
**
0123456789ABCDEF
/*--PROGRAM RTVRPGLES --DRIVER FOR RETRIEVE RPGLE SOURCE */
/* CPP FOR RTVRPGLES */
RTVRPGLES: PGM PARM(&PGMNAMLIB &SRCNAMLIB &MBRNAME)
DCL VAR(&PGMNAMLIB) TYPE(*CHAR) LEN(20)
DCL VAR(&SRCNAMLIB) TYPE(*CHAR) LEN(20)
DCL VAR(&OBJNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MBRNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PGMTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&NEWTEXT) TYPE(*CHAR) LEN(80)
DCL VAR(&ERROR) TYPE(*CHAR) LEN(1)
CHGVAR VAR(&OBJNAME) VALUE(%SST(&PGMNAMLIB 1 10))
CHGVAR VAR(&OBJLIB) VALUE(%SST(&PGMNAMLIB 11 10))
CHGVAR VAR(&SRCNAME) VALUE(%SST(&SRCNAMLIB 1 10))
CHGVAR VAR(&SRCLIB) VALUE(%SST(&SRCNAMLIB 11 10))
IF COND(&MBRNAME = '*PGM') THEN(CHGVAR +
VAR(&MBRNAME) VALUE(&OBJNAME))
RTVOBJD OBJ(&OBJLIB/&OBJNAME) OBJTYPE(*PGM) +
OBJATR(&PGMTYPE)
/*--Validate that requested object exists */
MONMSG MSGID(CPF9999) EXEC(DO)
SNDPGMMSG MSG('Requested program does not exist') +
MSGTYPE(*DIAG)
GOTO CMDLBL(ENDPGM)
ENDDO
/*--Validate that requested object is RPGLE */
IF COND(&PGMTYPE *NE 'RPGLE') THEN(DO)
SNDPGMMSG MSG('Requested program is no RPGLE') +
MSGTYPE(*DIAG)
GOTO CMDLBL(ENDPGM)
ENDDO
CHGVAR VAR(&NEWTEXT) VALUE('Retrieved source for ' || +
&OBJLIB |< '/' || &OBJNAME)
/*--Add requested output source member */
ADDPFM FILE(&SRCLIB/&SRCNAME) MBR(&MBRNAME) +
TEXT(&NEWTEXT) SRCTYPE(RPGLE)
MONMSG MSGID(CPF7306) EXEC(DO)
SNDPGMMSG MSG('Cannot add requested retrieval member') +
MSGTYPE(*DIAG)
GOTO CMDLBL(ENDPGM)
ENDDO
DMPOBJ OBJ(&OBJLIB/&OBJNAME) OBJTYPE(*PGM)
CRTDUPOBJ OBJ(RTVWORK) FROMLIB(*LIBL) OBJTYPE(*FILE) +
TOLIB(QTEMP)
MONMSG MSGID(CPF2130) EXEC(CLRPFM FILE(RTVWORK))
CPYSPLF FILE(QPSRVDMP) TOFILE(QTEMP/RTVWORK) +
SPLNBR(*LAST)
DLTSPLF FILE(QPSRVDMP) SPLNBR(*LAST)
CRTSRCPF FILE(QTEMP/QRPGLESRC) RCDLEN(112) MBR(*FILE) +
MAXMBRS(1)
MONMSG MSGID(CPF7302) EXEC(CLRPFM FILE(QTEMP/QRPGLESRC))
OVRDBF FILE(QRPGLESRC) TOFILE(QTEMP/QRPGLESRC) +
MBR(*FIRST)
OVRDBF FILE(RTVWORK) TOFILE(QTEMP/RTVWORK)
CALL PGM(RTVRPG) PARM(&ERROR)
DLTOVR FILE(QRPGLESRC)
DLTOVR FILE(RTVWORK)
IF COND(&ERROR *NE 'Y') THEN(DO)
CPYSRCF FROMFILE(QTEMP/QRPGLESRC) +
TOFILE(&SRCLIB/&SRCNAME) FROMMBR(*FIRST) +
TOMBR(&MBRNAME) MBROPT(*ADD) SRCOPT(*SEQNBR)
ENDDO
ELSE CMD(DO)
RMVM FILE(&SRCLIB/&SRCNAME) MBR(&MBRNAME)
SNDPGMMSG MSG('Requested program was not compiled with +
DBGVIEW(*LIST)') MSGTYPE(*DIAG)
ENDDO
CLRPFM FILE(QTEMP/RTVWORK)
CLRPFM FILE(QTEMP/QRPGLESRC)
ENDPGM: ENDPGM
*****************************************************************----
* RTVWORK WORK FILE FOR RTVRPGLES *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * ** * * **
A R RTVROKF
A FILL01 2
A HEXADR 6
A HEXSTUFF 79
A GOODSTUFF 32
A TRAILER 13
