Hola Jose Antonio: Estos ejemplos están sacados de un "RedBook" de IBM, no recuerdo ahora mismo su título. Espero te sirvan. Un saludo,
Javier Mora
________________________________
De: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] En nombre de Jose
Antonio
Enviado el: martes, 30 de septiembre de 2008 9:03
Para: forum help400
Asunto: Mapping program en RPG
Hola a todos.
Estoy trasteando el infoprint Server y trato de
guardar el PDF en un directorio especifico. Tiene alguien algún ejemplo de
mapping program para poder hacer esto.
Saludos.
A* RECORD FORMAT TO CREAT EMLOOKUP PHYSICAL FILE
A* CONTAINS DATA FOR THE PDF DISTRIBUTION
A*
A UNIQUE
A R EMEMAILR
A CUSTNO 6A COLHDG('CUSTOMER' 'NUMBER')
A COMP 25A COLHDG('COMPANY' 'NAME')
A PERSON 25A COLHDG('CONTACT')
A EADDR 80A COLHDG('EMAIL' 'ADDRESS')
A DISPEMAIL 1A COLHDG('SEND AS E-MAIL Y/N')
A VALUES('Y' 'N')
A DISPIFS 1A COLHDG('STORE IN IFS Y/N')
A VALUES('Y' 'N')
A DISPPDF 1A COLHDG('PRINT AS PDF Y/N')
A VALUES('Y' 'N')
A DISPAFP 1A COLHDG('PRINT AS AFP Y/N')
A VALUES('Y' 'N')
A K CUSTNO
FLOOKUP IF E K DISK EXTFILE('QGPL/LOOKUP')
D*
D INPUTDS DS
D JOBNAM 1 26
D SPLFID 27 36
D SPLNO 37 40B 0
D RTGTAG 41 290
D PDFFILE 291 630
D SVRTYPE 631 631
D RES1 632 632
D PATHCCSID 633 636B 0
D SENDER 637 646
D USRDTA 647 656
D SYSNAME 657 664
D TIMESTMP 665 672
D OUTQ 673 682
D OUTQLIB 683 692
D RES5 693 712
D FORMTYPE 713 722
D**********************************************
D OUTDS DS
D DISPOSTN 1
D CALLAGIN 1
D RES2 2
D MSGLEN 9B 0
D ADDRLEN 9B 0
D MSGTEXT 255
D RES3 1
D EXTOFF 9B 0
D CCSID 9B 0
D DSPPDFSTMF 1
D DSPPDFSPLF 1
D DSPPDFERR 1
D DSPAFPSPLF 1
D RES4 7
D ADDRESS 255
D*
D EXTLEN 9B 0
D SUBOFF 9B 0
D SUBLEN 9B 0
D RPLYOFF 9B 0
D RPLYLEN 9B 0
D CCOFF 9B 0
D CCLEN 9B 0
D BCCOFF 9B 0
D BCCLEN 9B 0
D BDYPTHOFF 9B 0
D DIRPTHOFF 9B 0
D DIRPTHLEN 9B 0
D ATTPTHOFF 9B 0
D STMFNAMOFF 9B 0
D STMFNAMLEN 9B 0
D EATTNAMOFF 9B 0
D EATTNAMLEN 9B 0
D PUBAUTOFF 9B 0
D PUBAUTLEN 9B 0
D PDFSPLOFF 9B 0
D PDFSPLLEN 9B 0
D AFPSPLOFF 9B 0
D AFPSPLLEN 9B 0
D ENCRPTOFF 9B 0
D ENCRPTLEN 9B 0
D*
D EXTSUBJ 80
D EXTRPLY 80
D EXTCC 80
D EXTBCC 80
D*
D BDYLEN 9B 0
D BDYNUM 9B 0
D BDYX1 9B 0
D BDYY1 9B 0
D BDYOFF1 9B 0
D BDYPLEN1 9B 0
D BDYUSE1 1
D BDYRES1 3
D BDYPTH1 80
D BDYX2 9B 0
D BDYY2 9B 0
D BDYOFF2 9B 0
D BDYPLEN2 9B 0
D BDYUSE2 1
D BDYRES2 3
D BDYPTH2 80
D BDYX3 9B 0
D BDYY3 9B 0
D BDYOFF3 9B 0
D BDYPLEN3 9B 0
D BDYUSE3 1
D BDYRES3 3
D BDYPTH3 80
D*
D ATTLEN 9B 0
D ATTNUMB 9B 0
D ATTX1 9B 0
D ATTY1 9B 0
D ATTOFF1 9B 0
D ATTPLEN1 9B 0
D ATTUSE1 1
D ATTRES1 3
D ATTPTH1 80
D ATTX2 9B 0
D ATTY2 9B 0
D ATTOFF2 9B 0
D ATTPLEN2 9B 0
D ATTUSE2 1
D ATTRES2 3
D ATTPTH2 80
D ATTX3 9B 0
D ATTY3 9B 0
D ATTOFF3 9B 0
D ATTPLEN3 9B 0
D ATTUSE3 1
D ATTRES3 3
D ATTPTH3 80
D*
D DIRPTH 80
D*
D PDFSTMFNAM 80
D PDFATTNAM 80
D PDFPUBAUT 10
D*
D PDFOUTQ 10
D PDFOUTQLIB 10
D PDFSPLNAM 10
D PDFUSRDTA 10
D PDFUSRDFN 255
D PDFFORM 10
D*
D AFPOUTQ 10
D AFPOUTQLIB 10
D AFPSPLNAM 10
D AFPUSRDTA 10
D AFPUSRDFN 255
D AFPFORM 10
D*
D PDFMASTPW 32
D PDFUSRPW 32
D PDFPRT 1
D PDFDOCCHG 1
D PDFCOPY 1
D PDFENCLVL 1
D PDFCNTACC 1
D PDFCHGCMT 1
D PDFDOCASB 1
D*
D INPUTLEN S 9B 0
D OUTPUTLEN S 9B 0
D OUTINFO S 9B 0
D**********************************************
C *ENTRY PLIST
C PARM INPUTDS
C PARM INPUTLEN
C PARM OUTDS
C PARM OUTPUTLEN
C PARM OUTINFO
C
C* Check to see if the output buffer is large enough. OUTPUTLEN
C* contains the initial length of the output buffer. If it is not
C* large enough, return with OUTINFO set to be the length required.
C* This program will be called right back with OUTPUTLEN = OUTINFO.
C*
C EVAL OUTINFO = 2509
C OUTINFO IFGT OUTPUTLEN
C RETURN
C ENDIF
C*
C* Set data structure to all '00's, to make sure there is no stray data in
C* any unused fields.
C*
C MOVE *ALLx'00' OUTDS
C*
C* Set more processing (CALLAGIN), reserved fields, and pointer to
C* extension area.
C EVAL CALLAGIN = '0'
C EVAL RES2 = X'0000'
C EVAL RES3 = X'00'
C EVAL RES4 = X'00000000000000'
C EVAL EXTOFF = 542
C EVAL EXTLEN = 100
C*
C* Lookup customer preferences record
C SUBST RTGTAG CUSTNO 6
C CUSTNO CHAIN LOOKUP
C
C* If customer record not found, tell PSF to send a message to PDFADMIN
C* by turning on the DSPPDFERR code.
C IF NOT %FOUND
C EVAL DSPPDFSTMF = '0'
C EVAL DSPPDFSPLF = '0'
C EVAL DSPPDFERR = '1'
C EVAL DSPAFPSPLF = '0'
C EVAL EXTOFF = 0
C RETURN
C ENDIF
C*
C* Error condition does not exist if found customer record.
C EVAL DSPPDFERR = '0'
C*
C* Customer found - evaluate different distributions.
C*
C* Check customer preference for e-mail
C DISPEMAIL IFEQ 'Y'
C* Mail the file
C* Base fields for e-mail
C EVAL DISPOSTN = '1'
C EVAL MSGLEN = 255
C EVAL ADDRLEN = 255
C EVAL MSGTEXT = 'Hello '
C + %TRIMR(PERSON) +', this is your invoice '
C + 'for ' + %TRIMR(COMP)+'.'
C EVAL CCSID = 0
C EVAL ADDRESS = EADDR
C* Extension Area for e-mail
C* Subject
C EVAL SUBOFF = 642
C EVAL SUBLEN = 80
C EVAL EXTSUBJ = 'Using Intelligent Routing'
C* Reply-to address for e-mail
C EVAL RPLYOFF = 722
C EVAL RPLYLEN = 80
C EVAL EXTRPLY = '''[EMAIL PROTECTED]'''
C* CC address for e-mail
C EVAL CCOFF = 802
C EVAL CCLEN = 80
C EVAL EXTCC = '''[EMAIL PROTECTED]'''
C +'''[EMAIL PROTECTED]'''
C* BCC address for e-mail
C EVAL BCCOFF = 882
C EVAL BCCLEN = 80
C EVAL EXTBCC = '''[EMAIL PROTECTED]'''
C* Rename PDF attachment
C EVAL EATTNAMOFF = 1738
C EVAL PDFATTNAM = 'Invoice #'
C + %subst(rtgtag:7:5) + '.pdf'
C EVAL EATTNAMLEN = 80
C*
C* Encryption of PDF file for e-mail
C EVAL ENCRPTOFF = 2438
C EVAL ENCRPTLEN = 71
C*
C EVAL PDFMASTPW = 'master'
C EVAL PDFUSRPW = ''
C EVAL PDFPRT = '1'
C EVAL PDFDOCCHG = '0'
C EVAL PDFCOPY = '0'
C EVAL PDFENCLVL = '2'
C EVAL PDFCNTACC = '1'
C EVAL PDFCHGCMT = '1'
C EVAL PDFDOCASB = '0'
C*
C* Directory for Body and Attachment files
C EVAL DIRPTHOFF = 1578
C EVAL DIRPTHLEN = 80
C EVAL DIRPTH = '/most'
C*
C* Set up body files
C EVAL BDYPTHOFF = 962
C EVAL BDYLEN = 308
C EVAL BDYNUM = 3
C*
C* Set up 1st body file
C EVAL BDYX1 = 100
C EVAL BDYY1 = 20
C EVAL BDYOFF1 = 20
C EVAL BDYUSE1 = '1'
C EVAL BDYRES1 = X'000000'
C EVAL BDYPTH1 = 'sample.htm'
C EVAL BDYPLEN1= %len(%trim(bdypth1))
C* Set up 2nd body file
C EVAL BDYX2 = 100
C EVAL BDYY2 = 20
C EVAL BDYOFF2 = 20
C EVAL BDYUSE2 = '0'
C EVAL BDYRES2 = X'000000'
C EVAL BDYPTH2 = '/More/iris.jpg'
C EVAL BDYPLEN2= %len(%trim(bdypth2))
C* Set up 3rd body file
C EVAL BDYX3 = 100
C EVAL BDYY3 = 20
C EVAL BDYOFF3 = 20
C EVAL BDYUSE3 = '1'
C EVAL BDYRES3 = X'000000'
C EVAL BDYPTH3 = 'ascii.txt'
C EVAL BDYPLEN3= %len(%trim(bdypth3))
C*
C* Set up attachment files
C EVAL ATTPTHOFF = 1270
C EVAL ATTLEN = 108
C EVAL ATTNUMB = 1
C*
C* Set up 1st attachment file
C EVAL ATTX1 = 100
C EVAL ATTY1 = 20
C EVAL ATTOFF1 = 20
C EVAL ATTUSE1 = '1'
C EVAL ATTRES1 = X'000000'
C EVAL ATTPTH1 = 'prices.123'
C EVAL ATTPLEN1= %len(%trim(attpth1))
C* Set up 2nd attachment file
C EVAL ATTX2 = 100
C EVAL ATTY2 = 20
C EVAL ATTOFF2 = 20
C EVAL ATTUSE2 = '0'
C EVAL ATTRES2 = X'000000'
C EVAL ATTPTH2 = ''
C EVAL ATTPLEN2= %len(%trim(attpth2))
C* Set up a 3rd attachment file
C EVAL ATTX3 = 100
C EVAL ATTY3 = 20
C EVAL ATTOFF3 = 20
C EVAL ATTUSE3 = '1'
C EVAL ATTRES3 = X'000000'
C EVAL ATTPTH3 = ''
C EVAL ATTPLEN3= %len(%trim(attpth3))
C*
C ELSE
C*
C* Do not e-mail
C EVAL DISPOSTN = '0'
C EVAL MSGLEN = 0
C EVAL ADDRLEN = 0
C EVAL MSGTEXT = ''
C EVAL ADDRESS = ''
C*
C ENDIF
C*
C* Check customer preference for storage in IFS
C DISPIFS IFEQ 'Y'
C*
C* Store the PDF file as a Stream File
C EVAL DSPPDFSTMF = '1'
C* Rename & set Authority for STMF
C EVAL STMFNAMOFF = 1658
C EVAL PDFSTMFNAM = '/invoices/2004-01/'
C + %SUBST(rtgtag:7:5) + '.pdf'
C EVAL STMFNAMLEN = 80
C EVAL PUBAUTOFF = 1818
C EVAL PDFPUBAUT = '*R'
C EVAL PUBAUTLEN = %len(%trim(pdfpubaut))
C*
C ELSE
C*
C* Do not store as stream file
C EVAL DSPPDFSTMF = '0'
C EVAL STMFNAMOFF = 0
C EVAL STMFNAMLEN = 0
C*
C ENDIF
C*
C* Check customer preference for creation of PDF Spooled File
C DISPPDF IFEQ 'Y'
C*
C* Create a PDF spooled file
C EVAL DSPPDFSPLF = '1'
C*
C* Attributes for PDF Spooled file
C EVAL PDFSPLOFF = 1828
C EVAL PDFSPLLEN = 305
C EVAL PDFOUTQ = 'PDFOUTQ'
C EVAL PDFOUTQLIB = 'qgpl'
C EVAL PDFSPLNAM = 'PDFSPLF'
C EVAL PDFUSRDTA = 'User Data'
C EVAL PDFUSRDFN = 'PDF User Dfn Dta'
C EVAL PDFFORM = '*SPLF'
C*
C ELSE
C*
C* Do not create PDF Spooled file
C EVAL DSPPDFSPLF = '0'
C EVAL PDFSPLOFF = 0
C EVAL PDFSPLLEN = 0
C*
C ENDIF
C*
C* Check customer preference for creation of AFP Spooled File
C DISPAFP IFEQ 'Y'
C*
C* Create an AFP spooled file
C EVAL DSPAFPSPLF = '1'
C*
C* Attributes for AFP Spooled file
C EVAL AFPSPLOFF = 2133
C EVAL AFPSPLLEN = 305
C EVAL AFPOUTQ = 'AFPOUTQ'
C EVAL AFPOUTQLIB = 'qgpl'
C EVAL AFPSPLNAM = 'AFPSPLF'
C EVAL AFPUSRDTA = 'User Data'
C EVAL AFPUSRDFN = 'AFP User Dfn Dta'
C EVAL AFPFORM = '*SPLF '
C*
C ELSE
C*
C* Do not create AFP Spooled file
C EVAL DSPAFPSPLF = '0'
C EVAL AFPSPLOFF = 0
C EVAL AFPSPLLEN = 0
C*
C ENDIF
C*
C*
C*
C RETURN
__________________________________________________ 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 visita la siguente URL: http://listas.combios.es/mailman/listinfo/forum.help400
